Hi All,

I have sheet1 with below data.

Col A Col B
123 AB
123 AC
123 AD
1234 AE
125 AF
145 AG

Col E should be my output.

Col D Col E
123 AB,AC,AD,AE
125 AF
145 AG

I was using the formula in cell E1 and copied across. ( array
function )
=INDEX($B$1:$B$6,SMALL(IF($A$1:$A$6=$D1,ROW($A$1:$A$6)),COLUMN(A:A)),
0)

I tried VBA

Sub test()

r1 = Cells(Rows.Count, "A").End(xlUp).Row
r2 = Cells(Rows.Count, "D").End(xlUp).Row

For a = 1 To r2

For i = 1 To r1

If Cells(a, "D") = Cells(i, "A") Then
res = Cells(i, "B")
temp = temp & "," & res
End If

Next i

With Application.WorksheetFunction
Cells(a, "E").Value = .Substitute(temp, ",", "", 1)
End With
temp = ""
Next a
End Sub


While running macro I got output in Col E as follows

Col D Col E
123 AB,AC,AD
125 AF
145 AG


Formula and VBA both are doing "exact" match but I want both close and
exact match.

Eg., ABC 123 DEF 456 is my data and I have another data as 123 DEF

In this case it should consider as matched.

Any VBA soultions ?

Thanks in advance

Hey

Have you tried using the Instr Function in vba
If instr(string,1'string2)>0 then

I think it will be better written in a function not a sub so its more
flexible adjusting the data range
Let me know with you need help writing the Function
What i figured its the same thing as a multiple vlookup

Cheers


"(E-Mail Removed)" wrote:

> Hi All,
>
> I have sheet1 with below data.
>
> Col A Col B
> 123 AB
> 123 AC
> 123 AD
> 1234 AE
> 125 AF
> 145 AG
>
> Col E should be my output.
>
> Col D Col E
> 123 AB,AC,AD,AE
> 125 AF
> 145 AG
>
> I was using the formula in cell E1 and copied across. ( array
> function )
> =INDEX($B$1:$B$6,SMALL(IF($A$1:$A$6=$D1,ROW($A$1:$A$6)),COLUMN(A:A)),
> 0)
>
> I tried VBA
>
> Sub test()
>
> r1 = Cells(Rows.Count, "A").End(xlUp).Row
> r2 = Cells(Rows.Count, "D").End(xlUp).Row
>
> For a = 1 To r2
>
> For i = 1 To r1
>
> If Cells(a, "D") = Cells(i, "A") Then
> res = Cells(i, "B")
> temp = temp & "," & res
> End If
>
> Next i
>
> With Application.WorksheetFunction
> Cells(a, "E").Value = .Substitute(temp, ",", "", 1)
> End With
> temp = ""
> Next a
> End Sub
>
>
> While running macro I got output in Col E as follows
>
> Col D Col E
> 123 AB,AC,AD
> 125 AF
> 145 AG
>
>
> Formula and VBA both are doing "exact" match but I want both close and
> exact match.
>
> Eg., ABC 123 DEF 456 is my data and I have another data as 123 DEF
>
> In this case it should consider as matched.
>
> Any VBA soultions ?
>
> Thanks in advance
>
>
>
>

Yeah, that would be helpful.

But I have more than 100 thousand rows in Col A and
I have more than 10,000 rows data for Col D

Is the UDF is the best for that?


On Mar 18, 5:33*pm, CmK <C...@discussions.microsoft.com> wrote:
> Hey
>
> Have you tried using the Instr Function in vba
> If instr(string,1'string2)>0 then
>
> I think it will be better written in a function not a sub so its more
> flexible adjusting the data range
> Let me know with you need help writing the Function
> What i figured its the same thing as a multiple vlookup
>
> Cheers
>
>
>
> "fi.or.jp...@gmail.com" wrote:
> > Hi All,
>
> > I have sheet1 with below data.
>
> > Col A * Col B
> > 123 * *AB
> > 123 * *AC
> > 123 * *AD
> > 1234 * AE
> > 125 * *AF
> > 145 * *AG
>
> > Col E should be my output.
>
> > Col D * Col E
> > 123 * * AB,AC,AD,AE
> > 125 * * AF
> > 145 * * AG
>
> > I was using the formula in cell E1 and copied across. ( array
> > function )
> > =INDEX($B$1:$B$6,SMALL(IF($A$1:$A$6=$D1,ROW($A$1:$A$6)),COLUMN(A:A)),
> > 0)
>
> > I tried VBA
>
> > Sub test()
>
> > r1 = Cells(Rows.Count, "A").End(xlUp).Row
> > r2 = Cells(Rows.Count, "D").End(xlUp).Row
>
> > For a = 1 To r2
>
> > For i = 1 To r1
>
> > If Cells(a, "D") = Cells(i, "A") Then
> > * *res = Cells(i, "B")
> > * *temp = temp & "," & res
> > End If
>
> > Next i
>
> > With Application.WorksheetFunction
> > Cells(a, "E").Value = .Substitute(temp, ",", "", 1)
> > End With
> > temp = ""
> > Next a
> > End Sub
>
> > While running macro I got output in Col E as follows
>
> > Col D * *Col E
> > 123 * * *AB,AC,AD
> > 125 * * *AF
> > 145 * * *AG
>
> > Formula and VBA both are doing "exact" match but I want both close and
> > exact match.
>
> > Eg., ABC 123 DEF 456 is my data and I have another data as 123 DEF
>
> > In this case it should consider as matched.
>
> > Any VBA soultions ?
>
> > Thanks in advance- Hide quoted text -
>
> - Show quoted text -

Change line
If Cells(a, "D") = Cells(i, "A") Then

to
If Cells(i, "A") Like Cells(a, "D") & "*" Then

Regards,
Stefi

„(E-Mail Removed)â€� ezt Ã*rta:

> Hi All,
>
> I have sheet1 with below data.
>
> Col A Col B
> 123 AB
> 123 AC
> 123 AD
> 1234 AE
> 125 AF
> 145 AG
>
> Col E should be my output.
>
> Col D Col E
> 123 AB,AC,AD,AE
> 125 AF
> 145 AG
>
> I was using the formula in cell E1 and copied across. ( array
> function )
> =INDEX($B$1:$B$6,SMALL(IF($A$1:$A$6=$D1,ROW($A$1:$A$6)),COLUMN(A:A)),
> 0)
>
> I tried VBA
>
> Sub test()
>
> r1 = Cells(Rows.Count, "A").End(xlUp).Row
> r2 = Cells(Rows.Count, "D").End(xlUp).Row
>
> For a = 1 To r2
>
> For i = 1 To r1
>
> If Cells(a, "D") = Cells(i, "A") Then
> res = Cells(i, "B")
> temp = temp & "," & res
> End If
>
> Next i
>
> With Application.WorksheetFunction
> Cells(a, "E").Value = .Substitute(temp, ",", "", 1)
> End With
> temp = ""
> Next a
> End Sub
>
>
> While running macro I got output in Col E as follows
>
> Col D Col E
> 123 AB,AC,AD
> 125 AF
> 145 AG
>
>
> Formula and VBA both are doing "exact" match but I want both close and
> exact match.
>
> Eg., ABC 123 DEF 456 is my data and I have another data as 123 DEF
>
> In this case it should consider as matched.
>
> Any VBA soultions ?
>
> Thanks in advance
>
>
>
>

Found this code a long time ago:
Sub ConcatData()
Dim X As Double
Dim DataArray(5000, 2) As Variant
Dim NbrFound As Double
Dim Y As Double
Dim Found As Integer
Dim NewWks As Worksheet

Cells(1, 1).Select
Let X = ActiveCell.Row
Do While True
If Len(Cells(X, 1).Value) = Empty Then
Exit Do
End If
If NbrFound = 0 Then
NbrFound = 1
DataArray(1, 1) = Cells(X, 1)
DataArray(1, 2) = Cells(X, 2)
Else
For Y = 1 To NbrFound
Found = 0
If DataArray(Y, 1) = Cells(X, 1).Value Then
DataArray(Y, 2) = DataArray(Y, 2) & ", " & Cells(X, 2)
Found = 1
Exit For
End If
Next
If Found = 0 Then
NbrFound = NbrFound + 1
DataArray(NbrFound, 1) = Cells(X, 1).Value
DataArray(NbrFound, 2) = Cells(X, 2).Value
End If
End If
X = X + 1
Loop

Set NewWks = Worksheets.Add
NewWks.Name = "SummarizedData"
Cells(1, 1).Value = "Names"
Cells(1, 2).Value = "Results"
X = 2
For Y = 1 To NbrFound
Cells(X, 1).Value = DataArray(Y, 1)
Cells(X, 2).Value = DataArray(Y, 2)
X = X + 1
Next
Beep
MsgBox ("Summary is done!")
End Sub


Regards,
Ryan---

--
RyGuy


"Stefi" wrote:

> Change line
> If Cells(a, "D") = Cells(i, "A") Then
>
> to
> If Cells(i, "A") Like Cells(a, "D") & "*" Then
>
> Regards,
> Stefi
>
> „(E-Mail Removed)â€� ezt Ã*rta:
>
> > Hi All,
> >
> > I have sheet1 with below data.
> >
> > Col A Col B
> > 123 AB
> > 123 AC
> > 123 AD
> > 1234 AE
> > 125 AF
> > 145 AG
> >
> > Col E should be my output.
> >
> > Col D Col E
> > 123 AB,AC,AD,AE
> > 125 AF
> > 145 AG
> >
> > I was using the formula in cell E1 and copied across. ( array
> > function )
> > =INDEX($B$1:$B$6,SMALL(IF($A$1:$A$6=$D1,ROW($A$1:$A$6)),COLUMN(A:A)),
> > 0)
> >
> > I tried VBA
> >
> > Sub test()
> >
> > r1 = Cells(Rows.Count, "A").End(xlUp).Row
> > r2 = Cells(Rows.Count, "D").End(xlUp).Row
> >
> > For a = 1 To r2
> >
> > For i = 1 To r1
> >
> > If Cells(a, "D") = Cells(i, "A") Then
> > res = Cells(i, "B")
> > temp = temp & "," & res
> > End If
> >
> > Next i
> >
> > With Application.WorksheetFunction
> > Cells(a, "E").Value = .Substitute(temp, ",", "", 1)
> > End With
> > temp = ""
> > Next a
> > End Sub
> >
> >
> > While running macro I got output in Col E as follows
> >
> > Col D Col E
> > 123 AB,AC,AD
> > 125 AF
> > 145 AG
> >
> >
> > Formula and VBA both are doing "exact" match but I want both close and
> > exact match.
> >
> > Eg., ABC 123 DEF 456 is my data and I have another data as 123 DEF
> >
> > In this case it should consider as matched.
> >
> > Any VBA soultions ?
> >
> > Thanks in advance
> >
> >
> >
> >

Good one stefi.

Thanks Ryan.