Search code examples
excelvbaloops

VBA for loop exercise with merged cells. How to get it right?


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

enter image description here

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 im actually hopeless. Please dont downvote my question again, im really seeking for help :((


Solution

  • 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