Transpose Column to Rows - Referencing Columns by Number

[mctopher]

I’m trying to create a macro that transposes data from columns to rows.

My source data is laid out so Column A and B contain item identifiers, and then the header for Column C to Column S contain dates (March, April, May, etc) and the row data below contains quantities for each month. This is on Sheet1.

I need my end data (on Sheet2) to have the item detail in Column A and B, the quantity in Column C and the Date in Column D. If there is a date that has no quantity then it should be skipped.

Sample Source Data (Pipes added for clarity, they aren't in the actual data)

Part |Description |June 4 |June 11 |June 18
A | PartA | 5 | | 12
(Please note June 11 has no quantity)

Sample Destination Data:

A | Part A | 5 | June 4
A | Part A | 12| June 18


Below is the start of the code, obviously I have a ways to go before it’s fully functional but hopefully you get the idea how I’m trying to attempt this. Where I’m having issues right now is referencing columns by number. Is there a way to do this so I can do Column = Column + 1 to advance columns to the right? Or are there any suggestions for a better way to address this all together?

Sub ConvertToRows()
 
Dim ReviewRow, ReviewRowEnd, PasteRow, ColumnNumber As Integer
 
ReviewRow = 2
PasteRow = 2
ReviewRowEnd = Range("A1048576").End(xlUp).Row
 
While ReviewRow <= ReviewRowEnd
    Range("A" & ReviewRow & ":B" & ReviewRow).Copy
        Sheets("Sheet2").Select
        Range("A" & PasteRow).Select
        ActiveSheet.Paste
 
       
'        Select (Column1.ReviewRow:Column2.ReviewRow).Copy
'        Sheet2.Column1.PasteRow Paste
'        Sheet1.Select
 
'        For Column3 to Column17
'            ActiveColum = ColumnNumber
 
'            While ColumnNumber <> ""
 
'                Range(ReviewRow.ColumnNumber.value) Copy
'                Sheet2.Column3.PasteRow
'                Sheet1.ActiveColumn.Row1 Copy
'                Sheet2.Column4.PasteRow Paste
'                PasteRow = PasteRow + 1
 
'            Wend
 
'        ActiveColumn = ActiveColumn + 1
 
'ReviewRow = ReviewRow + 1
 
Wend
 
End Sub

 

[mctopher]

For anyone else struggling with a similar issue, I found a way to get it to work using "Offset" instead of using the ColumnNumber and ColumnNumber + 1. Feel free to share any improvements to the code. Thanks!

Sub ConvertToRows()

Dim ReviewRow, ReviewRowEnd, PasteRow, ColumnNumber, Quantity, OffsetCounter As Integer
Dim ItemNumber, ItemDescription, CurrentColumn As String
Dim ScheduledDate As Date

ReviewRow = 2
PasteRow = 2

Sheets("Sheet1").Select
        
ReviewRowEnd = Range("A1048576").End(xlUp).Row

While ReviewRow <= ReviewRowEnd
    
    OffsetCounter = 0
    
    ItemNumber = Range("A" & ReviewRow).Value
    ItemDescription = Range("B" & ReviewRow).Value
    
    Range("C" & ReviewRow).Select

    While OffsetCounter < 17

        If ActiveCell.Value <> "" Then
            Quantity = ActiveCell.Value
            CurrentColumn = ActiveCell.Column
            ScheduledDate = Range("A1").Offset(0, CurrentColumn - 1).Value
            
            Sheets("Sheet2").Select
                Range("A" & PasteRow).Value = ItemNumber
                Range("B" & PasteRow).Value = ItemDescription
                Range("C" & PasteRow).Value = Quantity
                Range("D" & PasteRow).Value = ScheduledDate
                PasteRow = PasteRow + 1
            Sheets("Sheet1").Activate
        End If
            ActiveCell.Offset(0, 1).Select
            OffsetCounter = OffsetCounter + 1
     
    Wend

ReviewRow = ReviewRow + 1

Wend

MsgBox ("Completed!")

End Sub