Loop through only filtered visible rows

711 Views Asked by At

I have a problem with below code. I would like to filter "OS" (filed 61) then if first cell in 1st column below filters is not empty macro should go to first cell below filters in column "57", check if value in that cell is > 365 if yes it should go to column 62 in the same row and put there "overdue" if no then put there "OK". After that it should go to next row and check the same till the end of the filtered rows.

The problem is with visible only cells. Macro is doing it on all rows even not visible.

It should work only for filtered visible rows. Any suggestions?

Sub Patch_Overdue()

Dim i As Long
Dim LastRow As Long
  
Sheets("Sheet1").Select

'filter AIX OS

 Selection.Autofilter Field:=61, Criteria1:="AIX*"
 ActiveSheet.Autofilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, 61).Select

 If IsEmpty(Selection) = False Then

 LastRow = Range("a7").End(xlDown).Row

  For i = 1 To LastRow
     
   If ActiveSheet.Autofilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(i, 57).Value > 365 Then
   
   ActiveSheet.Autofilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(i, 62).Select
   ActiveCell.FormulaR1C1 = "Overdue"
     
   Else
   
   ActiveSheet.Autofilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(i, 62).Select
   ActiveCell.FormulaR1C1 = "OK"
     
   End If
     
   Next i

  Else

    ActiveSheet.ShowAllData

 End If

End Sub
1

There are 1 best solutions below

0
FaneDuru On

Please, try the next code. It is not tested, but it should work. Basically, it set the range to be processed based on the last cell in A:A and UserRange number of columns, extract the visible cells range, iterate between its areas and the between each area rows and check what you need:

Sub Patch_Overdue()
 Dim sh As Worksheet, rngUR As Range, rngVis As Range, i As Long, LastRow As Long
  
 Set sh = Sheets("Sheet1")
 If sh.AutoFilterMode Then sh.AutoFilterMode = False     'eliminate a previous filter to correctly calculate last row
 LastRow = sh.Range("A" & sh.rows.count).End(xlUp).row   'last row

 'filter AIX OS
  Set rngUR = sh.Range("A7", sh.cells(LastRow, sh.UsedRange.Columns.count)) 'set the range to be filtered
  rngUR.AutoFilter field:=61, Criteria1:="AIX*"                'filter the range according to criteria
  Set rngVis = rngUR.Offset(1).SpecialCells(xlCellTypeVisible) 'set the visible cells range

 Dim arRng As Range, r As Range
 For Each arRng In rngVis.Areas                 'iterate between the range areas:
    For Each r In arRng.rows                    'iterate between the area rows:
        If WorksheetFunction.CountA(r) > 0 Then 'for the case of the last row which is empty because of Offset
            If r.cells(1, 57).value > 356 Then
                r.cells(1, 62).value = "Overdue"
            Else
                r.cells(1, 62).value = "OK"
            End If
        End If
    Next
 Next
 sh.ShowAllData
End Sub