Autofill based on dynamic row

0
votes

I'm trying to figure out how to start an autofill based on a dynamic range. For each column in the 'starting table' I need to stack them on top of one another. My current code starting at 'LastRow' does not do this. I was hoping LastRow would give me a dynamic Range to autofill from, but instead I get the error, 'Object variable or With block variable not set'

How do I change my code so that '2Move' autofills to the new size of the table, without knowing where it starts? Then repeat the process for '3Move' and '4Move'

Sub shiftingColumns()

Dim sht As Worksheet
Dim LastRow As Range

Set sht = ActiveSheet

Set copyRange = Sheets("Sheet1").Range(Range("A2:B2"), Range("A2:B2").End(xlDown))
'Insert column & add header
Columns("C:C").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C1").Value = "Category"
'Move D1 Value to C2
Range("D1").Cut Destination:=Range("C2")
'Autofill C2 value to current table size
Range("C2").AutoFill Destination:=Range("C2:C" & Range("A" & Rows.Count).End(xlUp).Row)
'Copy copyRange below itself 
copyRange.Copy Destination:=Range("A" & Rows.Count).End(xlUp).Offset(1)
'Move E1 below autofilled ranged
Range("E1").Cut Destination:=Range("C" & Rows.Count).End(xlUp).Offset(1)
'LastRow = sht.Cells(sht.Rows.Count, "C").End(xlUp).Row
'LastRow.AutoFill Destination:=Range(LastRow & Range("A" & Rows.Count).End(xlUp).Row)
End Sub

This is the starting table

Starting Table

This is the desired table

Ending table

2
vbaexcel
Please give a mcve. It's honestly pretty hard to decipher your actual question here or what you are really attempting. – Scott Holtzman
@ScottHoltzman, there is no actual question. i read it several times and did not find one. – jsotola
I'll attempt to add an mcve tomorrow when I'm back at my computer. For now I've tried to clarify my question. Would it be beneficial to make a miniature table of what I'm attempting to do? – Reed Rawlings
I've updated my question. Hopefully it's more clear exactly what I'm asking. – Reed Rawlings
@ReedRawlings It appears that you are trying to 'flatten' your table. As an alternative I would suggest to use Pivot table to do that. Otherwise you will need a loop to accomplish your task instead of autofill. – Victor K

2 Answers

2
votes

For the benefit of those finding this via search engine, what you're looking to do isn't anything like autofill.

This should work for you, a loop.

Sub test()

    workingSheet = ActiveSheet.Name
    newSheet = "New Sheet"

    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets(newSheet).Delete
    Application.DisplayAlerts = True
    Sheets.Add.Name = newSheet
    Cells(1, 1) = "ID"
    Cells(1, 2) = "Color"
    Cells(1, 3) = "Category"
    On Error GoTo 0

    Sheets(workingSheet).Activate
    'Get last column
    x = Cells(1, 3).End(xlToRight).Column
    y = Cells(1, 1).End(xlDown).Row

    'Loop for each column from 3 (column "C") and after
    For i = 3 To x

        With Sheets(newSheet)

            newRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
            'Copy ID and Color
            Range(Cells(2, 1), Cells(y, 2)).Copy .Range(.Cells(newRow, 1), .Cells(newRow + y, 2))
            'Copy column header
            .Range(.Cells(newRow, 3), .Cells(newRow + (y - 2), 3)) = Cells(1, i)
            'Copy column values
            Range(Cells(2, i), Cells(y, i)).Copy .Range(.Cells(newRow, 4), .Cells(newRow + y, 4))
        End With

    Next

End Sub

If your demands vary, such as adding other "fixed" columns like ID and Color then you'll have to change the cell addressing and such.

2
votes

These two method will transpose the data much faster than Range.Copy and Range.Paste.

PivotTableValues - dumps the Range.Value into an array, data, then fills a second array, results, with the transposed values. Note: Transposed in this context simply means moved to a different place.

PivotTableValues2 - uses Arraylists to accomplish the OP's goals. Although it works great, it is somewhat a farcical answer. I just wanted to try this approach for esoteric reasons.

PivotTableValues Using Arrays

Sub PivotTableValues()
    Const FIXED_COLUMN_COUNT As Long = 2
    Dim ArrayRowCount As Long, Count As Long, ColumnCount As Long, RowCount As Long, x As Long, y As Long, y2 As Long
    Dim data As Variant, results As Variant, v As Variant

    With ThisWorkbook.Worksheets("Sheet1")
        RowCount = .Range("A" & .Rows.Count).End(xlUp).Row
        ColumnCount = .Cells(1, .Columns.Count).End(xlToLeft).Column
        data = Range(.Range("A" & .Rows.Count).End(xlUp), .Cells(1, .Columns.Count).End(xlToLeft)).Value

        ArrayRowCount = (ColumnCount - FIXED_COLUMN_COUNT) * (RowCount - 1) + 1

        ReDim results(1 To ArrayRowCount, 1 To FIXED_COLUMN_COUNT + 2)

        Count = 1
        For y = FIXED_COLUMN_COUNT + 1 To ColumnCount
            For x = 2 To RowCount
                Count = Count + 1
                results(Count, FIXED_COLUMN_COUNT + 1) = data(1, y)
                results(Count, FIXED_COLUMN_COUNT + 2) = data(x, y)
                For y2 = 1 To FIXED_COLUMN_COUNT
                    If Count = 2 Then
                        results(1, y2) = data(1, y2)
                        results(1, y2 + 1) = "Category"
                        results(1, y2 + 2) = "Value"
                    End If
                    results(Count, y2) = data(x, y2)
                Next
            Next
        Next

    End With

    With ThisWorkbook.Worksheets.Add
        .Range("A1").Resize(UBound(results), UBound(results, 2)).Value = results
        .Columns.AutoFit
    End With

End Sub

PivotTableValues2 Using ArrayLists

Sub PivotTableValues2()
    Const FIXED_COLUMN_COUNT As Long = 2
    Dim ColumnCount As Long, RowCount As Long, x As Long, y As Long
    Dim valueList As Object, baseList As Object, results As Variant, v As Variant
    Set valueList = CreateObject("System.Collections.ArrayList")
    Set baseList = CreateObject("System.Collections.ArrayList")

    With ThisWorkbook.Worksheets("Sheet1")
        RowCount = .Range("A" & .Rows.Count).End(xlUp).Row
        ColumnCount = .Cells(1, .Columns.Count).End(xlToLeft).Column

        For x = 1 To RowCount
            baseList.Add Application.Transpose(Application.Transpose(Range(.Cells(x, 1), .Cells(x, FIXED_COLUMN_COUNT))))
        Next

        For y = FIXED_COLUMN_COUNT + 2 To ColumnCount
            baseList.AddRange baseList.getRange(1, RowCount - 1)
        Next

        For y = FIXED_COLUMN_COUNT + 1 To ColumnCount
            For x = 2 To RowCount
                valueList.Add Array(.Cells(1, y).Value, .Cells(x, y).Value)
            Next
        Next

    End With

    results = Application.Transpose(Application.Transpose(baseList.ToArray))

    With ThisWorkbook.Worksheets.Add
        .Range("A1").Resize(UBound(results), UBound(results, 2)).Value = results
        valueList.Insert 0, Array("Category", "Value")

        results = Application.Transpose(Application.Transpose(valueList.ToArray))
        .Cells(1, FIXED_COLUMN_COUNT + 1).Resize(UBound(results), UBound(results, 2)).Value = results
        .Columns.AutoFit
    End With

End Sub