Converting horizontal data to vertical data.

[dwight]

I have a worksheet with the following data.

account name date checkno payment date checkno payment etc
100 fred 1/1/03 1234 35.45 2/1/03 3445 234.30

The spread sheet columns go to A to IU. What I need is each date,checkno
,payment group to be a new record for that account. The data is going to
be populated into a SQL Server db.

I have played around with doing a reverse pivot table, but I can't get
the results I need.

Any ideas on the fastest way to do this, would be appreciated.

Thanks

 

[Bernie Deitrick]

Dwight,

Select the entire table, and run the macro below - copy the macro into a codemodule in your workbook, but watch the line wrapping.

Note that this will only work for you specific table structure 2 columns of keys, then 3 columns of data, 3 columns of data.....
You'll have to clean up the formatting of the new table (on the new sheet).

HTH,
Bernie
Excel MVP

Sub MakeTable()
Dim myCell As Range
Dim newSheet As Worksheet
Dim mySheet As Worksheet
Dim i As Long
Dim j As Integer
Dim k As Long
Dim mySelection As Range

Set mySheet = ActiveSheet
Set mySelection = Selection
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("New Database").Delete
Set newSheet = Worksheets.Add
newSheet.Name = "New Database"
mySheet.Activate
newSheet.Cells(1, 1).Value = Cells(mySelection(1).Row, mySelection(1).Column).Value
newSheet.Cells(1, 2).Value = Cells(mySelection(1).Row, mySelection(1).Column + 1).Value
newSheet.Cells(1, 3).Value = Cells(mySelection(1).Row, mySelection(1).Column + 2).Value
newSheet.Cells(1, 4).Value = Cells(mySelection(1).Row, mySelection(1).Column + 3).Value
newSheet.Cells(1, 5).Value = Cells(mySelection(1).Row, mySelection(1).Column + 4).Value
i = 2
For k = mySelection(1).Row + 1 To mySelection(mySelection.Cells.Count).Row
For j = mySelection(1).Column + 2 To mySelection(mySelection.Cells.Count).Column Step 3
If mySheet.Cells(k, j).Value <> "" Then
newSheet.Cells(i, 1).Value = Cells(k, mySelection(1).Column).Value
newSheet.Cells(i, 2).Value = Cells(k, mySelection(1).Column + 1).Value
newSheet.Cells(i, 3).Value = Cells(k, j).Value
newSheet.Cells(i, 4).Value = Cells(k, j + 1).Value
newSheet.Cells(i, 5).Value = Cells(k, j + 2).Value
i = i + 1
End If
Next j
Next k

Application.DisplayAlerts = True

End Sub

 

[dwight]

Dwight,

Select the entire table, and run the macro below - copy the macro into a codemodule in your workbook, but watch the line wrapping.

Note that this will only work for you specific table structure 2 columns of keys, then 3 columns of data, 3 columns of data.....
You'll have to clean up the formatting of the new table (on the new sheet).

HTH,
Bernie
Excel MVP

Sub MakeTable()
Dim myCell As Range
Dim newSheet As Worksheet
Dim mySheet As Worksheet
Dim i As Long
Dim j As Integer
Dim k As Long
Dim mySelection As Range

Set mySheet = ActiveSheet
Set mySelection = Selection
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("New Database").Delete
Set newSheet = Worksheets.Add
newSheet.Name = "New Database"
mySheet.Activate
newSheet.Cells(1, 1).Value = Cells(mySelection(1).Row, mySelection(1).Column).Value
newSheet.Cells(1, 2).Value = Cells(mySelection(1).Row, mySelection(1).Column + 1).Value
newSheet.Cells(1, 3).Value = Cells(mySelection(1).Row, mySelection(1).Column + 2).Value
newSheet.Cells(1, 4).Value = Cells(mySelection(1).Row, mySelection(1).Column + 3).Value
newSheet.Cells(1, 5).Value = Cells(mySelection(1).Row, mySelection(1).Column + 4).Value
i = 2
For k = mySelection(1).Row + 1 To mySelection(mySelection.Cells.Count).Row
For j = mySelection(1).Column + 2 To mySelection(mySelection.Cells.Count).Column Step 3
If mySheet.Cells(k, j).Value <> "" Then
newSheet.Cells(i, 1).Value = Cells(k, mySelection(1).Column).Value
newSheet.Cells(i, 2).Value = Cells(k, mySelection(1).Column + 1).Value
newSheet.Cells(i, 3).Value = Cells(k, j).Value
newSheet.Cells(i, 4).Value = Cells(k, j + 1).Value
newSheet.Cells(i, 5).Value = Cells(k, j + 2).Value
i = i + 1
End If
Next j
Next k

Application.DisplayAlerts = True

End Sub

Thank you !!!

It worked, I can't believe you wrote this. I do appreciate it.