I want to produce output like this:
Header is already made, but rest using a formula or vba.
Maybe get a position of cell where value > 0 and offset it or use xlUp/xlLef?
But then what if there are more data to left of fruits and above the dates?
I want to produce output like this:
Header is already made, but rest using a formula or vba.
Maybe get a position of cell where value > 0 and offset it or use xlUp/xlLef?
But then what if there are more data to left of fruits and above the dates?
Something like this; manually select table and then run macro ... it will prompt for destination and write it out the list. Ignore's table cells that are blank.
Sub TableToList()
Dim rngSelection As Range
Dim rngDestination As Range
Dim lngRow As Long
Dim lngColumn As Long
Dim lngCounter As Long
' Ensure that the selection is at least 2 rows and 2 columns
Set rngSelection = Application.Selection
If rngSelection.Rows.Count < 2 Or rngSelection.Columns.Count < 2 Then
MsgBox "Selected data must have a minimum of two rows and two columns.", vbInformation
End
End If
' Ask the user to select the cell for where the list is to be written
Set rngDestination = Application.InputBox(prompt:="Select a destination cell:", Type:=8)
' Loop through the table and write out the list.
lngCounter = 0
For lngRow = 2 To rngSelection.Rows.Count
For lngColumn = 2 To rngSelection.Columns.Count
If ActiveCell.Cells(lngRow, lngColumn) <> "" Then
rngDestination.Offset(lngCounter, 0) = ActiveCell.Cells(lngRow, 1)
rngDestination.Offset(lngCounter, 1) = ActiveCell.Cells(1, lngColumn)
rngDestination.Offset(lngCounter, 2) = ActiveCell.Cells(lngRow, lngColumn)
lngCounter = lngCounter + 1
End If
Next
Next
End Sub