Damon Ostrander
MrExcel MVP
- Joined
- Feb 17, 2002
- Messages
- 4,239
Hi Mike,
Give this macro a try.
Sub TableToList()
Dim TWS As Worksheet 'Table worksheet
Dim iRow As Long 'Row index on Table worksheet
Dim iCol As Integer
Dim nRow As Long 'Row index on List worksheet
Dim CaseNo As Integer
Dim CaseName As String
'Save pointer to Table worksheet
Set TWS = ActiveSheet
'create new List worksheet
Worksheets.Add Worksheets(1)
ActiveSheet.Name = "List Sheet"
[a1] = "Case"
[b1] = "Name"
[c1] = "Fee Type"
[d1] = "$ Amt"
nRow = 1
For iRow = 2 To TWS.[a65536].End(xlUp).Row
CaseNo = TWS.Cells(iRow, 1)
CaseName = TWS.Cells(iRow, 2)
For iCol = 3 To 13 Step 2
If IsEmpty(TWS.Cells(iRow, iCol)) Then Exit For
nRow = nRow + 1
Cells(nRow, 1) = CaseNo
Cells(nRow, 2) = CaseName
Cells(nRow, 3) = TWS.Cells(iRow, iCol)
Cells(nRow, 4) = TWS.Cells(iRow, iCol + 1)
Next iCol
Next iRow
'uncomment the following line for automatic deletion of Table worksheet
'TWS.Delete
End Sub
Note that rather than modifying the worksheet 'in place' I chose to create a new worksheet to create the list, which is a bit safer. Then you can delete the Table worksheet when you have determined that the List worksheet has been correctly created. When you are confident that it is always working correctly you can uncomment the last line to have it delete the Table worksheet automatically.
This macro assumes the Table worksheet is the active worksheet at the time you run the macro.
Give this macro a try.
Sub TableToList()
Dim TWS As Worksheet 'Table worksheet
Dim iRow As Long 'Row index on Table worksheet
Dim iCol As Integer
Dim nRow As Long 'Row index on List worksheet
Dim CaseNo As Integer
Dim CaseName As String
'Save pointer to Table worksheet
Set TWS = ActiveSheet
'create new List worksheet
Worksheets.Add Worksheets(1)
ActiveSheet.Name = "List Sheet"
[a1] = "Case"
[b1] = "Name"
[c1] = "Fee Type"
[d1] = "$ Amt"
nRow = 1
For iRow = 2 To TWS.[a65536].End(xlUp).Row
CaseNo = TWS.Cells(iRow, 1)
CaseName = TWS.Cells(iRow, 2)
For iCol = 3 To 13 Step 2
If IsEmpty(TWS.Cells(iRow, iCol)) Then Exit For
nRow = nRow + 1
Cells(nRow, 1) = CaseNo
Cells(nRow, 2) = CaseName
Cells(nRow, 3) = TWS.Cells(iRow, iCol)
Cells(nRow, 4) = TWS.Cells(iRow, iCol + 1)
Next iCol
Next iRow
'uncomment the following line for automatic deletion of Table worksheet
'TWS.Delete
End Sub
Note that rather than modifying the worksheet 'in place' I chose to create a new worksheet to create the list, which is a bit safer. Then you can delete the Table worksheet when you have determined that the List worksheet has been correctly created. When you are confident that it is always working correctly you can uncomment the last line to have it delete the Table worksheet automatically.
This macro assumes the Table worksheet is the active worksheet at the time you run the macro.