0

Code:-

Sub Macro6()
'
' Macro6 Macro
'
' Keyboard Shortcut: Ctrl+Shift+A
'
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "p"
    Range("C1").Select
    Selection.AutoFilter
    ActiveSheet.Range("A1", Range("C" & Rows.Count).End(xlUp)).AutoFilter Field:=3, Criteria1:="Credit"
    ActiveCell.Offset(1, -1).Select
    'ActiveCell.Offset(1, 0).Select
    'Selection.AutoFilter
End Sub

It is giving the below result:-

enter image description here

But it should be "B5" in this case.

Mainly the changes are to be made in the below code:

    ActiveCell.Offset(1, -1).Select
jagu2020
  • 43
  • 7
  • 1
    [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) Rewrite your code incorporating the suggestions mentioned in that link and everything will be ok – Siddharth Rout Mar 14 '20 at 12:17
  • I still didn't get how exactly those answers are helpful for me to solve my query – jagu2020 Mar 14 '20 at 13:56
  • Avoid using Activecell and work with object and then use `.Offset(1, 0).SpecialCells(xlCellTypeVisible)` as shown [HERE](https://stackoverflow.com/questions/44593830/error-with-offset1-0-entirerow-delete) – Siddharth Rout Mar 14 '20 at 14:00
  • I am not a VBA developer, I have just recorded one macro and trying to edit to work in different situations. Therefore I am using Activecell. So could you please help me with the same working with Activecell. As I also tried as you said but didn't succeed. `With WS .Offset(1, 0).SpecialCells (xlCellTypeVisible) End With` – jagu2020 Mar 14 '20 at 15:12

1 Answers1

0

Autofilters can create non-contiguous ranges like $C$1:$C$2,$C$6,$C$11,$C$15,$C$19 which means having multiple areas to deal with.

Sub Macro6()

    Dim ws As Worksheet, lastrow As Long
    Dim rngFilter As Range, rng As Variant
    Set ws = ThisWorkbook.ActiveSheet
    ws.Columns("B:B").Insert Shift:=xlToRight

    ws.Range("B1").Value = "p"
    If ws.AutoFilterMode = True Then ws.AutoFilter.ShowAllData

    lastrow = ws.Range("C" & Rows.Count).End(xlUp).Row
    Set rngFilter = ws.Range("A1:C" & lastrow)
    rngFilter.AutoFilter Field:=3, Criteria1:="credit"
    Set rng = Intersect(rngFilter.SpecialCells(xlCellTypeVisible), ws.Columns(3))

    If rng.Areas.Count = 1 Then
        If rng.Cells.Count = 1 Then
            ' no cell to select
            MsgBox "No cell to select", vbCritical
        Else
            rng.Offset(1, -1).Select
        End If
    Else
        If rng.Areas(1).Cells.Count > 1 Then
            rng.Offset(1, -1).Select
        Else
            rng.Areas(2).Offset(0, -1).Select
        End If
    End If

End Sub
CDP1802
  • 13,871
  • 2
  • 7
  • 17