Rosh Hashana 1 | Rosh Hashana 2 | Yom Kippur | |
Maariv | Person 1 | Person 2 | Person 3 |
Shacharit | Person 4 | Person 5 | Person 6 |
Musaf | Person 7 | Person 8 | Person 9 |
When | What | Who |
Rosh Hashana 1 | Maariv | Person 1 |
Rosh Hashana 1 | Shacharit | Person 4 |
Rosh Hashana 1 | Musaf | Person 7 |
Rosh Hashana 2 | Maariv | Person 2 |
Rosh Hashana 2 | Shacharit | Person 5 |
Rosh Hashana 2 | Musaf | Person 8 |
Yom Kippur | Maariv | Person 3 |
Yom Kippur | Shacharit | Person 6 |
Yom Kippur | Musaf | Person 9 |
Sub createlist()
Dim source As Range
Set source = Range("B2:D4")
Dim dest As Range
Set dest = Range("F1")
dest.Range("A1:C1").Value = Array("When", "What", "Who")
Dim target As Range
Dim c As Range
For Each c In source.Cells
If Not IsEmpty(c.Value) Then
If IsEmpty(dest.Range("A2").Value) Then
Set target = dest.Range("A2")
Else
Set target = dest.End(xlDown).Range("A2")
End If
target.Range("C1").Formula = "=" & c.Address
target.Range("B1").Formula = "=" & c.EntireRow.Range("A1").Address ' row header
target.Range("A1").Formula = "=" & c.EntireColumn.Range("A1").Address ' column header
End If
Next c
End Sub
The key tricks was getting column/row headers with .EntireColumn/Row.Range("A1")
, and appending to the end of a list with
.End(xlDown).Range("A2")
. Unfortunately, End(xlDown)
is too clever; if the region contains only one item (like the column header only), it goes all the way to the end of the spreadsheet and the .Range("A2")
, which should get the next line, throws an error. Hence the If IsEmpty(dest.Range("A2").Value) Then
.
The If Not IsEmpty(c.Value) Then
line allows for blank spots in the original table to be ignored. VBA doesn't have a Continue
statement, just an equivalent for break
, called Exit For
.
Post a Comment