Transpose specific row data to columns

[Dragonlancer]

Greetings,

I am trying to figure a way to take specific row data and transpose it into columns:

Unprocessed data would look like the following:

EmployeeID PLAN PLAN_BEGINDATE PLAN_ENDDATE
1234567 HMO 01/01/2008 06/01/2008
1234567 Dental 01/01/2008 06/01/2008
1234567 Vision 01/01/2008 06/01/2008

Processed data would look like:

EmployeeID PLAN_1 PLAN_1_BEGINDATE PLAN_1_ENDDATE PLAN_2 PLAN_2_BEGINDATE PLAN_2_ENDDATE
1234567 HMO 01/01/2008 06/01/2008 Dental 01/01/2008 06/01/2008 Vision 01/01/2008 06/01/2008


....... until all plans are accounted for on one row of data for each employee. I have about 500 employees that I need to do this for with about 3 - 5 rows each.

Would any of you have a solution?

Sincerely,

Jason

[Bob Phillips]

Public Sub ProcessData()
Dim i As Long
Dim LastRow As Long

With Application

.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

With ActiveSheet

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = LastRow To 2 Step -1

If .Cells(i, "").Value = .Cells(i - 1, "A").Value Then

.Cells(i, "B").Resize(, 30).Copy .Cells(i - 1, "E")
.Rows(i).Delete
End If
Next i

End With

With Application

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub

[Dragonlancer]

Thank you for the example xld. ;-) Would you be able to break it down for a newbie?

[Bob Phillips]

Public Sub ProcessData()
Dim i As Long
Dim LastRow As Long

'turn off screen updating and Excel formula recalculation so as to make mcro faster
With Application

.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

With ActiveSheet

'calculate the last row of data by working from the end of the spreadsheet
' up until a data cell is encountered
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'loop though all rows from the bottom up (so as to maintain integrity
' of data as we delete rows
For i = LastRow To 2 Step -1

'if the value in column A of current row is the sams as the value in
' column A of the previous row
If .Cells(i, "").Value = .Cells(i - 1, "A").Value Then

'copy all of cells B:XX from this row to previous row
.Cells(i, "B").Resize(, 30).Copy .Cells(i - 1, "E")
'the delete this row
.Rows(i).Delete
End If
Next i

End With

'Reset the system#With Application

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub

[Dragonlancer]

Thank you for the remarks and it helps to have these. When I run the code I get a "type mismatch" on the line:

If .Cells(i, "").Value = .Cells(i - 1, "A").Value Then

...when I am reading the numeric employee ID's. I have tried several things and can't seem to get past it.

[Bob Phillips]

That is because the idiot that gave you the code should have written



If .Cells(i, "A").Value = .Cells(i - 1, "A").Value Then

[Dragonlancer]

Got it to work! :-) Thank you.

[Dragonlancer]

Geeezzz. They threw another curve at me that I have been beating my head on and can't seam to solve myself. I have been using your code above but can't seem to solve the problem. There are samples attached that may explain better what I am trying to accomplish. If I can figure this one out I'll be a happy geek.

The output is a feed file for an insurance provider and they can only have one row per dependant. However, the source data has multiple rows depending on the plans they are in.

Medical Plans = PPO, HMO
Dental Plans = DMO, PDP
Vison Plan = Vision

These yahoo's want the plan info moved to their respective columns like in the sample_output.xls.:banghead:
:dunno
Sincerely,

Dragonlancer1970

[Bob Phillips]

Public Sub ProcessData()
Dim i As Long, j As Long
Dim LastRow As Long

With Application

.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

With ActiveSheet

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = LastRow To 2 Step -1

For j = 25 To 10 Step -5

If .Cells(i, j).Value <> "" Then

.Rows(i + 1).Insert
.Cells(i, "A").Resize(, 9).Copy .Cells(i + 1, "A")
.Cells(i, j).Resize(, 5).Copy .Cells(i + 1, "J")
End If
Next j
.Rows(i).Delete
Next i

End With

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub

[Dragonlancer]

Thank you. I ran and get a screen flash but no change in the data. Tried several things and can't seem to get it to more the data on the input sample.