I need to write a VBA script using a loop or a few loops, which in the end will print the data, by debug.print looking like this:

can, kg, green, pea, 24.79

Here is the image of how my sheet looks like:

Sub ExtractTableData()
        Dim ws As Worksheet
        Set ws = ActiveSheet
        
        Dim row As Integer, col As Integer
        Dim lastRow As Integer, lastCol As Integer
        Dim category As String, unit As String
        Dim color As String, item As String, value As Variant
        
        
        lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
        lastCol = ws.Cells(2, Columns.Count).End(xlToLeft).Column
    
        For row = 3 To lastRow 
            category = ws.Cells(row, 1).Value  ' Category (can/bag/jar)
            unit = ws.Cells(row, 2).Value      ' Unit (kg/piece)
            
            For col = 3 To lastCol
    
                If ws.Cells(1, col).MergeCells Then
                    color = ws.Cells(1, col).MergeArea.Cells(1, 1).Value
                Else
                    color = ws.Cells(1, col).Value
                End If
                
                item = ws.Cells(2, col).Value
                
                value = ws.Cells(row, col).Value
                
                If Not IsEmpty(value) Then
                    Debug.Print category & ", " & unit & ", " & color & ", " & item & ", " & value
                End If
            Next col
        Next row
End Sub

I can do simpler versions of this exercise by setting a range and looping through it, but when it comes with merged cells.

I need to write a VBA script using a loop or a few loops, which in the end will print the data, by debug.print looking like this:

can, kg, green, pea, 24.79

Here is the image of how my sheet looks like:

Sub ExtractTableData()
        Dim ws As Worksheet
        Set ws = ActiveSheet
        
        Dim row As Integer, col As Integer
        Dim lastRow As Integer, lastCol As Integer
        Dim category As String, unit As String
        Dim color As String, item As String, value As Variant
        
        
        lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
        lastCol = ws.Cells(2, Columns.Count).End(xlToLeft).Column
    
        For row = 3 To lastRow 
            category = ws.Cells(row, 1).Value  ' Category (can/bag/jar)
            unit = ws.Cells(row, 2).Value      ' Unit (kg/piece)
            
            For col = 3 To lastCol
    
                If ws.Cells(1, col).MergeCells Then
                    color = ws.Cells(1, col).MergeArea.Cells(1, 1).Value
                Else
                    color = ws.Cells(1, col).Value
                End If
                
                item = ws.Cells(2, col).Value
                
                value = ws.Cells(row, col).Value
                
                If Not IsEmpty(value) Then
                    Debug.Print category & ", " & unit & ", " & color & ", " & item & ", " & value
                End If
            Next col
        Next row
End Sub

I can do simpler versions of this exercise by setting a range and looping through it, but when it comes with merged cells.

• excel
• vba
• loops

Share Improve this question Follow edited Mar 24 at 0:49 CPPUIX 2,39988 gold badges1616 silver badges3535 bronze badges asked Mar 4 at 13:07 BerkBerk2115BerkBerk2115 944 bronze badges 0

Add a comment  | 

1 Answer 1

Sorted by: Reset to default 0

Transform Data: Unpivot If Number

Sub ExtractTableData()
    
    ' Rows
    Const COLOR_ROW As Long = 2
    Const ITEM_ROW As Long = 3
    Const FIRST_DATA_ROW As Long = 4
    ' Columns
    Const CATEGORY_COLUMN As Long = 2
    Const UNIT_COLUMN As Long = 3
    Const FIRST_DATA_COLUMN As Long = 5
    
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    ' Worksheet
    Dim ws As Worksheet: Set ws = wb.Sheets("Sheet1")
    ' Last Row and Column
    Dim LastRow As Long:
    LastRow = ws.Cells(ws.Rows.Count, CATEGORY_COLUMN).End(xlUp).Row
    Dim LastCol As Long:
    LastCol = ws.Cells(ITEM_ROW, ws.Columns.Count).End(xlToLeft).Column
    
    ' Additional variables.
    Dim Value As Variant, Row As Long, Col As Long
    Dim Category As String, Unit As String, Color As String, Item As String

    ' Loop
    For Row = FIRST_DATA_ROW To LastRow
        For Col = FIRST_DATA_COLUMN To LastCol
            Value = ws.Cells(Row, Col).Value
            If VarType(Value) = vbDouble Then ' is a number; IMO, most accurate
            'If Len(Value) > 0 Then
            'If Value <> "" Then
                Category = ws.Cells(Row, CATEGORY_COLUMN).Value
                Unit = ws.Cells(Row, UNIT_COLUMN).Value
                If ws.Cells(COLOR_ROW, Col).MergeCells Then
                    Color = ws.Cells(COLOR_ROW, Col).MergeArea.Cells(1).Value
                Else
                    Color = ws.Cells(COLOR_ROW, Col).Value
                End If
                Item = ws.Cells(ITEM_ROW, Col).Value
                Debug.Print Category & ", " & Unit & ", " & Color _
                    & ", " & Item & ", " & Value
            'Else ' no need to read anything if no value!!!
            End If
        Next Col
    Next Row

End Sub