Converting Header Rows to Add'l Detail in Rows

[krisfj40]

I am working with a spreadsheet created from our mainframe and need some
assistance in converting it to a file easily used for data mining. The
records are numbered by 1,2,3 ; where 1=header row, 2=detailed records for
each header row, 3=sum count of the # of detailed records. Here is a sample
of the data:

A B C D E F
1 Test Texas PlanNumber RedLight
2 John Addy State ZipCode Expense
2 Sally Addy State ZipCode Expense
2 Jake Addy State ZipCode Expense
2 Hank Addy State ZipCode Expense
3 4
1 Test Okl PlanNumber YellowLight
2 Lily Addy State ZipCode Expense
2 Deb Addy State ZipCode Expense
2 Joe Addy State ZipCode Expense
3 3

Here's the output I need:
A B C D E F G H
I J K
1 Test Texas PlanNumber RedLight 2 John Addy State ZipCode
Expense
1 Test Texas PlanNumber RedLight 2 Sally Addy State ZipCode
Expense
1 Test Texas PlanNumber RedLight 2 Jake Addy State ZipCode
Expense
1 Test Texas PlanNumber RedLight 2 Hank Addy State ZipCode
Expense
3 4

Any help would be GREATLY appreciated! I have 50 weekly files throughout
2009 with over 20k records each!

 

[Rick Rothstein]

Give this macro a try (change the assignments in the two Const statements to
match your actual conditions)...

Sub ConsolidateDataRows()
Dim X As Long, FirstAddressRow As Long
Dim Rng As Range, One As Range, Three As Range
Const StartRow As Long = 1
Const SheetName As String = "Sheet1"
With Worksheets(SheetName)
Set Rng = .Range("A" & StartRow & ":A" & Rows.Count)
Set One = Rng.Find("1", After:=.Cells(Rows.Count, "A"), _
LookIn:=xlValues, LookAt:=xlWhole, _
SearchDirection:=xlNext)
If Not One Is Nothing Then
FirstAddressRow = One.Row
Set Three = Rng.Find("3", After:=One, LookIn:=xlValues, _
LookAt:=xlWhole, SearchDirection:=xlNext)
Do
With Range(One.Offset(1), Three.Offset(-1)).Resize(, 6)
.Copy One.Offset(1, 5)
.Resize(, .Columns.Count - 1).Value = One.Resize(, 5).Value
One.EntireRow.Delete
End With
Set One = Rng.Find("1", After:=Three, LookIn:=xlValues, _
LookAt:=xlWhole, SearchDirection:=xlNext)
Set Three = Rng.Find("3", After:=One, LookIn:=xlValues, _
LookAt:=xlWhole, SearchDirection:=xlNext)
Loop While One.Row > FirstAddressRow
End If
End With
End Sub

 

[Rob van Gelder]

Sub test()
Const cFirstRow = 1
Dim i As Long
Dim strItemName As String, strState As String, strPlan As String, strLight As String
Dim rngDest As Range

Set rngDest = Sheet2.Cells(1, 1)

With Sheet1
For i = cFirstRow To .Cells(Rows.Count, 1).End(xlUp).Row
If .Cells(i, 1) = 1 Then
strItemName = .Cells(i, 2)
strState = .Cells(i, 3)
strPlan = .Cells(i, 4)
strLight = .Cells(i, 5)

ElseIf .Cells(i, 1) = 2 Then
rngDest = 1
rngDest.Offset(0, 1) = strItemName
rngDest.Offset(0, 2) = strState
rngDest.Offset(0, 3) = strPlan
rngDest.Offset(0, 4) = strLight
rngDest.Offset(0, 5) = .Cells(i, 1)
rngDest.Offset(0, 6) = .Cells(i, 2)
rngDest.Offset(0, 7) = .Cells(i, 3)
rngDest.Offset(0, 8) = .Cells(i, 4)
rngDest.Offset(0, 9) = .Cells(i, 5)
rngDest.Offset(0, 10) = .Cells(i, 6)

Set rngDest = rngDest.Offset(1, 0)

ElseIf .Cells(i, 1) = 3 Then
rngDest = .Cells(i, 1)
rngDest.Offset(0, 1) = .Cells(i, 2)

Set rngDest = rngDest.Offset(1, 0)

End If
Next
End With
End Sub


Cheers,
Rob

 

[krisfj40]

Rick,
Thank you! This is "almost" working. The reason I say almost is because my
header record 1 has data in columns A, B, C, D, G, H, and I (notice E, F are
blanks). The data in record type 2 has data in columns A-H, J for every row
and some of them also use column I (but not all).

The macro is only grabbing the header record data in columns A, B, C, and D.

As you have probably noticed, I am not a programmer, so your assistance is
greatly appreciated!!

Kris

 

[krisfj40]

I figured it out and it seems to be working. Thank you! Here is the macro I
used...

Sub ConsolidateDataRows()
Dim X As Long, FirstAddressRow As Long
Dim Rng As Range, One As Range, Three As Range
Const StartRow As Long = 1
Const SheetName As String = "Sheet1"
With Worksheets(SheetName)
Set Rng = .Range("A" & StartRow & ":A" & Rows.Count)
Set One = Rng.Find("1", After:=.Cells(Rows.Count, "A"), _
LookIn:=xlValues, LookAt:=xlPart, _
SearchDirection:=xlNext)
If Not One Is Nothing Then
FirstAddressRow = One.Row
Set Twelve = Rng.Find("3", After:=One, LookIn:=xlValues, _
LookAt:=xlPart, SearchDirection:=xlNext)
Do
With Range(One.Offset(1), Twelve.Offset(-1)).Resize(, 10)
.Copy One.Offset(1, 9)
.Resize(, .Columns.Count - 1).Value = One.Resize(, 9).Value
One.EntireRow.Delete
End With
Set One = Rng.Find("1", After:=Twelve, LookIn:=xlValues, _
LookAt:=xlPart, SearchDirection:=xlNext)
Set Twelve = Rng.Find("3", After:=One, LookIn:=xlValues, _
LookAt:=xlPart, SearchDirection:=xlNext)
Loop While One.Row > FirstAddressRow
End If
End With
End Sub