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.
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