Hi Mark,
Am Mon, 17 Feb 2020 20:02:03 -0800 (PST) schrieb
noodnutt@gmail.com:
I get asked some interesting questions by people thinking just because I know a sprinkling of VBA, I can do god-like things... lol.
So! I was asked the following:
Assumed ranges:
A = Names
B = PO
Lets assume the following:
NAME: PO:
ABC123 P/L 1234567
ABC123 P/L 2345678
ABC123 P/L 3456789
They would like:
NAME: PO:
ABC123 P/L 1234567, 2345678, 3456789
I don't understand your layout correctly.
Following code works if the names are in column A and the PO in column Q
of sheets Import and sheets Import is sorted by name:
Sub Con()
Dim sWs As Worksheet, tWs As Worksheet
Dim LRowI As Long, LRowC As Long
Dim fMatch As Long
Dim myCnt As Integer
Dim varPO As Variant
Dim rngC As Range
Set sWs = Worksheets("Import"): Set tWs = Worksheets("Conv")
LRowI = sWs.Cells(Rows.Count, "A").End(xlUp).Row
sWs.Range("A1:A" & LRowI).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=tWs.Range("A1"), Unique:=True
LRowC = tWs.Cells(Rows.Count, "A").End(xlUp).Row
For Each rngC In tWs.Range("A2:A" & LRowC)
fMatch = Application.Match(rngC, sWs.Range("A1:A" & LRowI), 0)
myCnt = Application.CountIf(sWs.Range("A:A"), rngC)
If myCnt > 1 Then
varPO = Application.Transpose(sWs.Cells(fMatch, "Q").Resize(myCnt))
rngC.Offset(, 1) = Join(varPO, ", ")
Else
rngC.Offset(, 1) = sWs.Cells(fMatch, "Q")
End If
Next
End Sub
Regards
Claus B.
--
Windows10
Office 2016
--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)