Help with some code that Martin wrote

[Dan R.]

Martin wrote this code a while back and I'm trying to manipulate it so
that it returns the highest value in column 4 only, not a concatenation
of all the values in column 4.

Basically the code does this:

Input:
A B C D
Europe Germany Name1 Frankfurt
Europe Germany Name1 Munich
Europe France Name2 Paris
Asia Japan Name3 Tokyo
Asia Japan Name3 Osaka

Output:
A B C D
Europe Germany Name1 Frankfurt, Munich
Europe France Name2 Paris
Asia Japan Name3 Tokyo, Osaka

Here's the code:

Option Explicit

Sub concat()

Dim lRowFirst As Long
Dim lRowLast As Long
Dim lRow As Long
lRowFirst = ActiveCell.CurrentRegion.Row + 1
lRowLast = ActiveCell.CurrentRegion.Rows.Count + lRowFirst - 2

For lRow = lRowLast To lRowFirst Step -1
If Cells(lRow, 1) = Cells(lRow - 1, 1) And _
Cells(lRow, 2) = Cells(lRow - 1, 2) And _
Cells(lRow, 3) = Cells(lRow - 1, 3) Then
Cells(lRow - 1, 4) = Cells(lRow - 1, 4) _
& ", " & Cells(lRow, 4)
Rows(lRow).Delete
End If
Next lRow

End Sub

Thank You,
-- Dan

 

[Bob Phillips]

Sub concat()
Dim lRowFirst As Long
Dim lRowLast As Long
Dim lLastCol As Long
Dim lRow As Long
lRowFirst = ActiveCell.CurrentRegion.Row + 1
lRowLast = ActiveCell.CurrentRegion.Rows.Count + lRowFirst - 2

For lRow = lRowLast To lRowFirst Step -1
If Cells(lRow, 1) = Cells(lRow - 1, 1) And _
Cells(lRow, 2) = Cells(lRow - 1, 2) And _
Cells(lRow, 3) = Cells(lRow - 1, 3) Then
lLastCol = Cells(lRow, Columns.Count).End(xlToLeft).Column
Cells(lRow, 4).Resize(, lLastCol - 3).Copy Cells(lRow - 1, 5)
Rows(lRow).Delete
End If
Next lRow

End Sub

--
---
HTH

Bob

(change the xxxx to gmail if mailing direct)

 

[Dan R.]

Perfect, thanks Bob.

Sub concat()
Dim lRowFirst As Long
Dim lRowLast As Long
Dim lLastCol As Long
Dim lRow As Long
lRowFirst = ActiveCell.CurrentRegion.Row + 1
lRowLast = ActiveCell.CurrentRegion.Rows.Count + lRowFirst - 2

For lRow = lRowLast To lRowFirst Step -1
If Cells(lRow, 1) = Cells(lRow - 1, 1) And _
Cells(lRow, 2) = Cells(lRow - 1, 2) And _
Cells(lRow, 3) = Cells(lRow - 1, 3) Then
lLastCol = Cells(lRow, Columns.Count).End(xlToLeft).Column
Cells(lRow, 4).Resize(, lLastCol - 3).Copy Cells(lRow - 1, 5)
Rows(lRow).Delete
End If
Next lRow

End Sub

--
---
HTH

Bob

(change the xxxx to gmail if mailing direct)