Close Match
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
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
|