#### omairhe

##### Well-known Member
Hey all, I was hoping to get some macro working for this specific job and I thought it would be nice to ask you for it. Well, I have data in column A with around 100 rows. in column B there are 2 letter abbreviations which I achieved using left(A1,2) formula. Then I deleted duplicate values in column B. So the abbreviations are short like 30 rows because its not being repeated. so now what I need is a code that can put in front of each abbreviation the data matched in column A in seperate columns.

for instance:

Column A
Row 1--- cat
Row 2--- can
Row 3--- caffien
Row 4--- cash
Row 5--- map

Column B
Row 1--- ca
Row 2--- ma

Result should be:-

Column C
Row 1--- cat
Row 2--- map

Column D
Row 1--- can

Column E
Row 1--- caffien

Column F
Row 1--- cash

Hope it make sense,

will be appreciating any help at all,

Thanks.

### Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.

#### Russell Hauf

##### MrExcel MVP
I don't think you need a macro. Keep all of the duplicate values in column B (so re-apply your formula), then create a pivot table based on columns A and B (one will be row values, the other column)...I have not tested but believe it should work.

#### MickG

##### MrExcel MVP
Try this:-
NB:-This code should achieve your require result based on column "A" , with results starting "B1"
Code:
``````[COLOR="Navy"]Sub[/COLOR] MG23Dec52
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Sp [COLOR="Navy"]As[/COLOR] Variant, K [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng: .Item(Dn.Value) = Empty: [COLOR="Navy"]Next[/COLOR] Dn
Ray = .keys: .RemoveAll
[COLOR="Navy"]For[/COLOR] n = 0 To UBound(Ray)
Txt = Left(Ray(n), 2)
[COLOR="Navy"]If[/COLOR] Not .Exists(Txt) [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]Else[/COLOR]
.Item(Txt) = .Item(Txt) & "," & Ray(n)
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
c = c + 1
Sp = Split(.Item(K), ",")
Range("B" & c) = K
Range("C" & c).Resize(, UBound(Sp) + 1) = Sp
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]``````
Regards Mick

#### omairhe

##### Well-known Member
MickG, this saved me plenty of time...

Cheers, Thank You..

Try this:-
NB:-This code should achieve your require result based on column "A" , with results starting "B1"
Code:
``````[COLOR=Navy]Sub[/COLOR] MG23Dec52
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range, n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Txt [COLOR=Navy]As[/COLOR] [COLOR=Navy]String,[/COLOR] Ray [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] Sp [COLOR=Navy]As[/COLOR] Variant, K [COLOR=Navy]As[/COLOR] Variant, c [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
[COLOR=Navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng: .Item(Dn.Value) = Empty: [COLOR=Navy]Next[/COLOR] Dn
Ray = .keys: .RemoveAll
[COLOR=Navy]For[/COLOR] n = 0 To UBound(Ray)
Txt = Left(Ray(n), 2)
[COLOR=Navy]If[/COLOR] Not .Exists(Txt) [COLOR=Navy]Then[/COLOR]
[COLOR=Navy]Else[/COLOR]
.Item(Txt) = .Item(Txt) & "," & Ray(n)
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR] n
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] K [COLOR=Navy]In[/COLOR] .keys
c = c + 1
Sp = Split(.Item(K), ",")
Range("B" & c) = K
Range("C" & c).Resize(, UBound(Sp) + 1) = Sp
[COLOR=Navy]Next[/COLOR] K
[COLOR=Navy]End[/COLOR] With
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]``````
Regards Mick

#### hiker95

##### Well-known Member
omairhe,

Here is another macro solution for you to consider.

Sample raw data:

Excel 2007
ABCDEFG
1catca
2canma
3caffien
4cash
5map
6
Sheet1

And, after the macro:

Excel 2007
ABCDEFG
1catcacatcancaffiencash
2canmamap
3caffien
4cash
5map
6
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Code:
``````Sub FindColumnBInColA()
' hiker95, 12/23/2016, ME092300
Dim a As Range, b As Range, nc As Long, lc As Long
For Each b In Range("B1", Range("B" & Rows.Count).End(xlUp))
For Each a In Range("A1", Range("A" & Rows.Count).End(xlUp))
If InStr(a, b) Then
nc = Cells(b.Row, Columns.Count).End(xlToLeft).Column + 1
Cells(b.Row, nc) = a.Value
End If
Next a
Next b
lc = Cells.Find("*", , xlValues, xlWhole, xlByColumns, xlPrevious, False).Column
Columns(1).Resize(, lc).AutoFit
End Sub``````

Then run the FindColumnBInColA macro.

#### hiker95

##### Well-known Member
omairhe,

The macro in my reply #5 is based on the displayed raw data strings in column A.

I will be back in a little while with an updated macro.

#### hiker95

##### Well-known Member
omairhe,

Here is an updated macro for you to consider.

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Code:
``````Sub FindColumnBInColA_V2()
' hiker95, 12/23/2016, ME092300
Dim a As Range, b As Range, nc As Long, lc As Long
For Each b In Range("B1", Range("B" & Rows.Count).End(xlUp))
For Each a In Range("A1", Range("A" & Rows.Count).End(xlUp))
If Left(a, 2) = b Then
nc = Cells(b.Row, Columns.Count).End(xlToLeft).Column + 1
Cells(b.Row, nc) = a.Value
End If
Next a
Next b
lc = Cells.Find("*", , xlValues, xlWhole, xlByColumns, xlPrevious, False).Column
Columns(1).Resize(, lc).AutoFit
End Sub``````

Then run the FindColumnBInColA_V2 macro.

Replies
10
Views
2K
Replies
1
Views
166
Replies
3
Views
324
Replies
0
Views
203
Replies
1
Views
365

1,191,190
Messages
5,985,202
Members
439,947
Latest member
fabiannic

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back