Macro please.

[omairhe]

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.

 

[Russell Hauf]

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]

Try this:-
NB:-This code should achieve your require result based on column "A" , with results starting "B1"

[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]
        .Add Txt, Ray(n)
    [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]

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"

[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]
        .Add Txt, Ray(n)
    [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]

omairhe,

Here is another macro solution for you to consider.

Sample raw data:

Excel 2007
	A	B	C	D	E	F	G
1	cat	ca
2	can	ma
3	caffien
4	cash
5	map
6
Sheet1

And, after the macro:

Excel 2007
	A	B	C	D	E	F	G
1	cat	ca	cat	can	caffien	cash
2	can	ma	map
3	caffien
4	cash
5	map
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).

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]

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]

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).

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.