'Loop through only filtered visible rows
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
Solution 1:[1]
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
Sources
This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.
Source: Stack Overflow
| Solution | Source |
|---|---|
| Solution 1 | FaneDuru |
