Concatenation query

[Greshter]

Hi Again

I must be getting lazy as I keep coming back to this group! I have
three columns of records that have lots of duplicates in the first two
columns. I need to find a formula or code that will concatenate the
last column's records. To give you a better idea here is a sample of
the records:

Abrahams Bay 258 - 259 G2
Abruzzi Glacier 202 - 203 B3
Absolum Creek 148 - 149 H4
Acheron Lakes 222 - 223 F2
Acheron Passage 230 - 231 D3
Acheron River 176 - 177 D3
Acheron River 152 - 153 E4
Acheron River 152 - 153 F3
Acheron River 152 - 153 G2
Acheron River 144 - 145 E5
Acheron River 144 - 145 F4
Acheron River 144 - 145 F5
Aciphylla Creek 174 - 175 D2
Acland Lagoon 182 - 183 D3
Acton Stream 234 - 235 B1
Acton Stream 234 - 235 C2
Acton Stream 222 - 223 H6
Ada River 150 - 151 G4

The finished copy would ideally look like this:


Abrahams Bay 258 - 259 G2
Abruzzi Glacier 202 - 203 B3
Absolum Creek 148 - 149 H4
Acheron Lakes 222 - 223 F2
Acheron Passage 230 - 231 D3
Acheron River 176 - 177 D3
Acheron River 152 - 153 E4/F3/G2
Acheron River 144 - 145 E5/F4/F5
Aciphylla Creek 174 - 175 D2
Acland Lagoon 182 - 183 D3
Acton Stream 234 - 235 B1/C2
Acton Stream 222 - 223 H6
Ada River 150 - 151 G4

So the first two columns have to be the same before concatenating the
last column. There are about 6000 records so it would be great if this
could be automated. Any assistance with this quandary would be greatly
appreciated.

Cheers,
Mike

 

[abcd]

Public Sub Group()
Dim a$, b$, i&
' starting with A1 but you can change it below
With Range("A1")
a$ = .Value
b$ = .Offset(0, 1).Value
i = .Row + 1: j = .Column
End With
next_a$ = Cells(i, j).Value
next_b$ = Cells(i, j + 1).Value

While next_a$ <> ""
Rows(i).Select
If ((a = next_a) And (b = next_b)) Then
Cells(i - 1, j + 2).Value = Cells(i - 1, j + 2).Value & "/" &
Cells(i, j + 2).Value
Rows(i).Delete
Else
a = next_a
b = next_b
i = i + 1
End If
next_a$ = Cells(i, j).Value
next_b$ = Cells(i, j + 1).Value
Wend
End Sub

 

[Greshter]

abcd

That was on the money.

Many thanks and great bit of code.

Cheers,
Mike

 

[abcd]

ok but just note that the

Rows(i).Select

was onlu for test purpose, no need to it