Convert Columns to Rows based upon a duplicate value

[EJR]

I have columnar data in the four headings below;

A B C
D
Loan Number / Taxpayer ID Number / Customer Name / SCR21

It is possible that there is information for two customer four each loan.
Is there a way for my to compare the values in the "Loan Number" column in
rows 3 and 2, and if it matches the cell above, copy the contents for columns
B, C & D and paste the to Columns E, F & G in row # 2?

Thanks for any help, EJR

 

[Ken Hudson]

Hi EJR,

Try the following code. Be sure to make a copy of your workbook first! After
moving the duplicate names, the code will delete the extra row. Post back if
you need to have this modified or if you need help setting up the macro.

Option Explicit
Dim Iloop As Double
Dim RowCount As Double
Sub MoveDupes()

'Turn off warnings, etc.
Application.ScreenUpdating = False
Application.DisplayAlerts = False

RowCount = Cells(Rows.Count, "A").End(xlUp).Row
For Iloop = RowCount To 2 Step -1
If Cells(Iloop, "A") = Cells(Iloop - 1, "A") Then
Cells(Iloop - 1, "E") = Cells(Iloop, "B")
Cells(Iloop - 1, "F") = Cells(Iloop, "C")
Cells(Iloop - 1, "G") = Cells(Iloop, "D")
Rows(Iloop).Delete
End If
Next Iloop

'Turn on warnings, etc.
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

 

[Joel]

The code below will delete the row with the same Loan Number

Sub combinrows()

RowCount = 1
Do While Range("A" & RowCount) <> ""
If Range("A" & RowCount) = _
Range("A" & (RowCount + 1)) Then

Range("B" & (RowCount + 1) & "" & _
(RowCount + 1)).Copy _
Destination:=Range("E" & RowCount)

Rows(RowCount + 1).Delete
Else
RowCount = RowCount + 1
End If
Loop

End Sub


if you don't want the row deleted then use this code

Sub combinrows()

RowCount = 1
Do While Range("A" & RowCount) <> ""
If Range("A" & RowCount) = _
Range("A" & (RowCount + 1)) Then

Range("B" & (RowCount + 1) & "" & _
(RowCount + 1)).Copy _
Destination:=Range("E" & RowCount)
End If

RowCount = RowCount + 1
Loop

End Sub

 

[EJR]

Hello Ken,
Thanks for your quick response. It worked like a charm.
Regards,
Evan R