Excel VBA looping: reshape column into table

Question

I have not used VBA for sometime so am very rusty... What I have is a number of records stored vertically (in a single column) and I want to use VBA to stack them side by side (into a table).

My general thoughts about how this would flow:

1. Start at first range
2. Copy data
3. Paste data in cell B3 of output page (just named Sheet2)
4. Loop back to previous range and offset by 51 rows
5. Copy data
6. Paste data in cell C3 of output page (offset by 1 column each time)

My attempt so far:

    Sub Macro1()        
        FiftyOne = 51 ' Offset by 51 rows for every chunk
        StartRange = "L262:L303" ' Start at this range of data to copy, each chunk is identical in size
        OutputRange = B3 ' Paste in output at B3, but need to offset by one column each time     

        Range(StartRange).Offset(FiftyOne, 0).Select
        Selection.Copy

        Sheets("Sheet2").Select
        Range("B3").Offset(0, 1).Select
        ActiveSheet.Paste    
    End Sub

I know this is a rather lame attempt to tackle this flow, but I am really struggling with how to loop through this. I would appreciate some advice on how to do this, or a better approach to the general flow.

---

Edit after accepting Wolfie's answer:

I want to assign column headings, by getting the values from C258 and looping down (in a similar way to before) 51 rows at a time, to paste into row 2 of sheet2 (B2, C2, ...).

Here is my current attempt:

Sub NameToTable()
    ' Assign first block to range, using easily changable parameters
    ' Remember to "Dim" all of your variables, using colon for line continuation

    Dim blocksize As Long: blocksize = 51
    Dim firstrow As Long:  firstrow = 258
    Dim rng As Range

    Set rng = ThisWorkbook.Sheets("Sheet1").Range("C" & firstrow & blocksize - 1)
    ' tablestart is the upper left corner of the "pasted" table



    Dim tablestart As Range: Set tablestart = ThisWorkbook.Sheets("Sheet2").Range("B2")
    Dim i As Long                      ' Looping variable i
    Dim nblocks As Long: nblocks = 10  ' We're going to loop nblocks number of times

    For i = 0 To nblocks - 1
        ' Do the actual value copying, using Resize to set the number of rows
        ' and using Offset to move down the original values and along the "pasted" columns
        tablestart.Offset(0, i).Resize(blocksize, 1).Value = _
                                                      rng.Offset(blocksize * i, 0).Value
    Next i
End Sub

Answer 1

Your logic seems alright, this code will create a 51 x n table, lining up each vertical block of 51 cells in its own column.

Note, it's much quicker to assign the .Value than copying and pasting, if you need formats too then you could copy/paste or similarly set format properties equal.

Sub ColumnToTable()
    ' Assign first block to range, using easily changable parameters
    ' Remember to "Dim" all of your variables, using colon for line continuation
    Dim blocksize As Long: blocksize = 51
    Dim firstrow As Long:  firstrow = 262
    Dim rng As Range
    Set rng = ThisWorkbook.Sheets("Sheet1").Range("L" & firstrow & ":L" & firstrow + blocksize - 1)
    ' tablestart is the upper left corner of the "pasted" table
    Dim tablestart As Range: Set tablestart = ThisWorkbook.Sheets("Sheet2").Range("B3")
    Dim i As Long                      ' Looping variable i
    Dim nblocks As Long: nblocks = 10  ' We're going to loop nblocks number of times
    For i = 0 To nblocks - 1
        ' Do the actual value copying, using Resize to set the number of rows
        ' and using Offset to move down the original values and along the "pasted" columns
        tablestart.Offset(0, i).Resize(blocksize, 1).Value = _
                                                      rng.Offset(blocksize * i, 0).Value
    Next i
End Sub

Set the nblocks value to suit your needs, this is the number of resulting columns in your output table. You could get it dynamically by knowing the number of rows in the original column. Or you could use some while logic, careful to make sure that it does eventually exit of course!

Dim i As Long: i = 0
Do While rng.Offset(blocksize*i, 0).Cells(1).Value <> ""
    tablestart.Offset(0, i).Resize(blocksize, 1).Value = rng.Offset(blocksize * i, 0).Value
    i = i + 1
Loop

---

Edit: to get your column headings, keep in mind that the column headings are only 1 cell, so:

' Change this:
Set rng = ThisWorkbook.Sheets("Sheet1").Range("C" & firstrow & blocksize - 1)
' To this:
Set rng = ThisWorkbook.Sheets("Sheet1").Range("C" & firstrow)

Tip: + is used for adding numerical values, whilst & is used for concatenating stings.

Now when you're looping, you don't need the Resize, because you are only assigning 1 cell's value to 1 other cell. Resulting sub:

Sub NameToTable()
    Dim blocksize As Long: blocksize = 51
    Dim firstrow As Long:  firstrow = 258
    Dim rng As Range    
    Set rng = ThisWorkbook.Sheets("Sheet1").Range("C" & firstrow)   
    Dim tablestart As Range: Set tablestart = ThisWorkbook.Sheets("Sheet2").Range("B2")
    Dim i As Long: i = 0
    Do While rng.Offset(blocksize*i, 0).Value <> ""
        tablestart.Offset(0, i).Value = rng.Offset(blocksize * i, 0).Value
        i = i + 1
    Loop
End Sub

Answer 2

When dealing with your worksheets in excel, each time you reference them adds overhead and slows down the code, what you want to do is take all of the info off your spreadsheet into an array then use Application.Transpose to transpose it for you.

You can then use 'Resize' to make sure your destination range is the same size and set the values.

Sub CopyAndTransRange(src As Range, dest As Range)
    Dim arr As Variant                          'Needs to be a variant to take cell values
    arr = Application.Transpose(src.Value)      'Set to array of values

    On Error GoTo eh1dim                        'Capture error from vertical 1D range
    dest.Resize( _
        UBound(arr, 1) - LBound(arr, 1) + 1, _
        UBound(arr, 2) - LBound(arr, 2) + 1 _
    ) = arr                                     'Set destination to array
Exit Sub
eh1dim:
    dest.Resize( _
        1, _
        UBound(arr) - LBound(arr) + 1 _
    ) = arr                                     'Set row to 1D array
End Sub

Note, Application.Transpose will fall over with some arrays in weird circumstances like if there is more than 255 characters in a string in the given array, for those situations you can write your own Transpose function to flip the array for you.

Edit:

When you feed a vertical 1-dimensional range and transpose it, VBA converts it to a 1-dimensional array, I've rewritten so it captures the error when this happens then adjusts accordingly.

Answer 3

Just made this example which has values 1 through 7 populated on the first 7 rows of column A. This code effectively loops through each of the values, and transposes horizontally so all values are on a single row (1).

Dim rng As Range
Dim crng As Range
Static value As Integer

Set rng = ActiveSheet.Range("A1", Range("A1").End(xlDown))

    For Each crng In rng.Cells
        ActiveSheet.Range("A1").Offset(0, value).value = crng.value
        If value <> 0 Then
            crng.value = ""
        End If
        value = value + 1
    Next crng

First we grab the required range and then iterate through each cell. Then using the offset method and an incrementing integer, we can assign their values horizontally to a single row.

It's worth noting that this would work when trying to transpose both vertically and horizontally. The key is the offset(column, row).

Just adjust where you place your incrementing Integer.

Hope this helps.