I use my macro to sort through lots of item numbers and set the offset column values based on the next and previous items in the list. This is done after filtering for the current level of each item. I have a few macros that do similar things but I need the offset to only offset by visible rows. Much of my macro may be sloppy but all I'm asking for help with is offsetting by visible rows. You will see the offset code near the bottom of this macro.
Private Sub Alias_Preceed()
Dim Arr(), Arr2() As Variant
Dim R, r2 As Long
Dim C, c2 As Long
Dim flt As String
Dim mr, mr2, cc As Range
Dim mc, mcc As Integer
Sheets("Current Pivot").Select
Arr = Range("A2:A3548")
For R = 1 To UBound(Arr, 1)
For C = 1 To UBound(Arr, 2)
flt = Arr(R, C)
Sheets("Master").Select
If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
ActiveSheet.ShowAllData
End If
ActiveSheet.Range("$A$1:$G$13254").AutoFilter Field:=2, Criteria1:= _
flt
Range("A2:A13254").SpecialCells(xlCellTypeVisible).select
mr = Range("A2:A13254").SpecialCells(xlCellTypeVisible)
Set mr2 = mr
mc = mr2.Count
mcc = 0
For Each mr In Intersect(Selection, ActiveSheet.UsedRange)
mcc = mcc + 1
If mcc = 1 Then
GoTo NextMR
End If
Set cc = mr
cc.Offset(0, 4).Value = cc.Offset(-1, 0).Value
NextMR:
Next mr
NextCP:
Next C
Next R
End Sub
Answer:
No one answered if there's a way to offset by visible cells which would've made this process easier. As a workaround I made my macro copy visible cells to a separate worksheet, apply the code, and copy that to another worksheet.
There's some "select" in there but it still runs fast so I don't feel like modifying it. The entire macro is very long but here's the relevant part of my macro:
For r = 1 To UBound(Arr, 1) ' First array dimension is rows.
For C = 1 To UBound(Arr, 2) ' Second array dimension is columns.
flt = Arr(r, C)
Sheets("TempSheet").Select
Cells.Delete Shift:=xlUp
Cells.Delete Shift:=xlUp
Sheets("Master").Select
If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
ActiveSheet.ShowAllData
End If
'ActiveSheet.Range("$A$1:$AF$25").AutoFilter Field:=2, Criteria1:= _
flt
'ActiveSheet.Range("$A$1:$AF$13254").AutoFilter Field:=2, Criteria1:= _
flt
ActiveSheet.Range(FR).AutoFilter Field:=2, Criteria1:= _
flt
'Range("A2:AF25").SpecialCells(xlCellTypeVisible).Copy 'CHANGE FILTER RANGE
'Range("A2:AF13254").SpecialCells(xlCellTypeVisible).Copy 'CHANGE FILTER RANGE
Range(FR).SpecialCells(xlCellTypeVisible).Copy 'CHANGE FILTER RANGE
Sheets("TempSheet").Select
ActiveSheet.Paste Destination:=Worksheets("TempSheet").Range("A1")
lastRow = Range("A"& Rows.Count).End(xlUp).Row
Range("A1:A"& lastRow).Select
mr = Selection
Set mr2 = Selection
MC = mr2.Count
mcc = 0
Range("A1:A"& lastRow).Select
For Each mr In Intersect(Selection, ActiveSheet.UsedRange)
mcc = mcc + 1
If mcc = MC Then
Set cc = mr
cc.Offset(0, 2).Value = cc.Offset(-MC + 1, 0).Value
GoTo NextCL
End If
Set cc = mr
cc.Offset(0, 2).Value = cc.Offset(1, 0).Value
Next mr
NextCL:
Sheets("TempSheet").Select
lastRow = Range("A"& Rows.Count).End(xlUp).Row
Range("A1:E"& lastRow).Select
Selection.Copy
Sheets("AddL").Select
lastRow = Range("A"& Rows.Count).End(xlUp).Row
Range("A"& (lastRow + 1)).Select
ActiveSheet.Paste
Sheets("AddL").Select
Next C
Next r