Hello BJPhil,
The macro below has been added to the attached workbook. If have any problems with it, let me know.
A button (Run) has also been been added to the worksheet to run the macro.
Sub Macro1()
' Thread: http://www.excelforum.com/excel-programming-vba-macros/1003920-convert-multiple-columns-to-rows-including-blank-cells.html
Dim c As Long
Dim Data As Variant
Dim n As Long
Dim r As Long
Dim Rng As Range
Dim Who As String
Dim Wks As Worksheet
Set Wks = Worksheets("Sheet1")
Set Rng = Wks.Range("A1").CurrentRegion
n = (Wks.Cells(1, Columns.Count).End(xlToLeft).Column - 1) / 4
r = Rng.Rows.Count - 1
ReDim Data(1 To (r * n), 1 To 5)
n = 1
For r = 2 To Rng.Rows.Count
Who = Rng.Cells(r, 1)
For c = 2 To Rng.Columns.Count Step 4
Data(n, 2) = Rng.Cells(r, c + 0)
Data(n, 3) = Rng.Cells(r, c + 1)
Data(n, 4) = Rng.Cells(r, c + 2)
Data(n, 5) = Rng.Cells(r, c + 3)
x = Application.Match("*", Array(Data(n, 2), Data(n, 3), Data(n, 4), Data(n, 5)), 0)
If Not IsError(x) Then
Data(n, 1) = Who
n = n + 1
End If
Next c
Next r
Wks.Range("A11:D11").Resize(UBound(Data), 5).Value = Data
End Sub
Bookmarks