Quantcast
Channel: Active questions tagged excel - Stack Overflow
Viewing all articles
Browse latest Browse all 90209

Trying to offset by visible cells in long macro

$
0
0

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

Viewing all articles
Browse latest Browse all 90209

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>