Trying to scrape pivot results by moving row to adjacent column

Question

I am running a VBA macro that takes a value you enter, feeds it into a filter on a pivot table, then uses the pivot table results to generate a new resultant table with size (:,2) with the separator row (top in select field) brought to the right of the other values (as an index) to then take the results back to a different sheet in the workbook.

Some important notes:

All data is in str format
All index values are entirely numbers
Some data values start with numbers
Some sections where an index is listed 2x in the database instead have up to 16 datapoints before a new index is passed. This is the reason my original code with just every 8 was not working.
The results may be any length from 8 datapoints to hundreds, xlDown has not been working for setting the range so I just set A1:A1000

Current results:

Everything seems to work until I hit an index with multiple datasets in which case my (Row-2) mod 8 = 0 function is thrown off
Index is copying over properly in those cases and deleting the blank row
Data from final table is pulled to other spreadsheet reliably

Some things I have tried:

IsNumeric seems to parse strings starting with a number and throwing it off as True
Because not all values contain 8 datapoints I tried adding an adjustment value to fix the indexing if it was not numeric but still at the correct index

Tried just dragging the value down for 16 rows so if a number is found it will overwrite. This did NOT work.

ActiveSheet.PivotTables("PivotTable1").PivotFields("searchcode").CurrentPage = Sheets("report").Range("B4").Value
    Range("A5:A1000").Select
    Selection.copy
    Sheets("scratch").Select
    Range("A1").Select
    ActiveSheet.Paste
    ActiveSheet.Range("A1", "A1000").Select

    Dim Myrange As Range
    Dim Myrow As Range
    Dim Adjust As Integer
    Adjust = 2
    Set Myrange = Selection
    For Each Myrow In Myrange.Rows
        If IsNumeric(Myrow.Row) And ((Myrow.Row = Adjust Or (Myrow.Row - Adjust) Mod 9 = 0)) Then

            Sheets("scratch").Range("B" & Myrow.Row + 1).Value() = Range("A" & Myrow.Row).Value()
            Sheets("scratch").Range("B" & Myrow.Row + 2).Value() = Range("A" & Myrow.Row).Value()
            Sheets("scratch").Range("B" & Myrow.Row + 3).Value() = Range("A" & Myrow.Row).Value()
            Sheets("scratch").Range("B" & Myrow.Row + 4).Value() = Range("A" & Myrow.Row).Value()
            Sheets("scratch").Range("B" & Myrow.Row + 5).Value() = Range("A" & Myrow.Row).Value()
            Sheets("scratch").Range("B" & Myrow.Row + 6).Value() = Range("A" & Myrow.Row).Value()
            Sheets("scratch").Range("B" & Myrow.Row + 7).Value() = Range("A" & Myrow.Row).Value()
            Sheets("scratch").Range("B" & Myrow.Row + 8).Value() = Range("A" & Myrow.Row).Value()
            Sheets("scratch").Range("B" & Myrow.Row + 9).Value() = Range("A" & Myrow.Row).Value()
            Sheets("scratch").Range("B" & Myrow.Row + 10).Value() = Range("A" & Myrow.Row).Value()
            Sheets("scratch").Range("B" & Myrow.Row + 11).Value() = Range("A" & Myrow.Row).Value()
            Sheets("scratch").Range("B" & Myrow.Row + 12).Value() = Range("A" & Myrow.Row).Value()
            Sheets("scratch").Range("B" & Myrow.Row + 13).Value() = Range("A" & Myrow.Row).Value()
            Sheets("scratch").Range("B" & Myrow.Row + 14).Value() = Range("A" & Myrow.Row).Value()
            Sheets("scratch").Range("B" & Myrow.Row + 15).Value() = Range("A" & Myrow.Row).Value()
            Sheets("scratch").Range("B" & Myrow.Row + 16).Value() = Range("A" & Myrow.Row).Value()

            Range("A" & Myrow.Row).Clear

        ElseIf (Not (IsNumeric(Myrow.Row))) And ((Myrow.Row = Adjust Or (Myrow.Row - Adjust) Mod 9 = 0)) Then

            Adjust = Adjust + 1

        End If

    Next Myrow

    Application.CutCopyMode = False
    ActiveSheet.Range("A1:A1000") = [index(lower(A1:A1000),)]
    ActiveSheet.Range("A1:A1000") = [index(trim(A1:A1000),)]
    ActiveSheet.Range("A1:A1000").Select
    Selection.Replace What:="(blank)", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="-", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="â€", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="~*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

For this, my pivot table looks something like this:

Filter 1 (All)  
Filter 2 (Code)  

Row Labels  
Index 1  
data1  
data2  
data3  
data4  
data5  
data6  
data7  
data8  
Index 2  
data1  
data2  
data3  
data4  
data5  
data6  
data7  
data8  
Index 3  
data1  
data2  
data3  
...

What I want:

Filter 1 (All)  
Filter 2 (Code)  

Row Labels  
data1 Index1  
data2 Index1  
data3 Index1  
data4 Index1  
data5 Index1  
data6 Index1  
data7 Index1  
data8 Index1  
data1 Index2  
data2 Index2  
data3 Index2  
data4 Index2  
data5 Index2  
data6 Index2  
data7 Index2  
data8 Index2  
data1 Index3  
data2 Index3  
data3 Index3  
...

You might benefit from reading [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). — Pᴇʜ, May 10 '19 at 06:14

score 0 · Accepted Answer · answered May 13 '19 at 18:07

So I decided to take this a different direction with error handling to test numeric or string cell contents. I then used a IsNumeric on Variant types to see if the value should be brought to the cell.

    Dim Myrange As Range
    Dim Myrow As Range
    Dim Temp As Variant
    Dim NextTemp As Variant

    Set Myrange = Selection
    For Each Myrow In Myrange.Rows
        NextTemp = Range("A" & Myrow.Row).Value
        If IsEmpty(Range("A" & Myrow.Row)) Then
          Exit For
        ElseIf IsNumeric(NextTemp) Then
            Temp = NextTemp
            Range("A" & Myrow.Row).Value = ""
        Else
            Range("B" & Myrow.Row).Value = Temp
                End If
    Next Myrow

Feel free to reach out if you want more information (i haven't done a bunch of these so I am not sure how to do this)

Trying to scrape pivot results by moving row to adjacent column

1 Answers1