Grrr... of course there's something new... 192-00333-0002-119(1) and 192-00333-0002-119 are not the same thing, so I taught the new function to strip out any parenthetical strings at the end of each substring before doing the individual Vlookups....
Option Explicit
Function VLOOKUPMANY(MyVal As Range, MyRange As Range, MyCol As Long, _
NoDupes As Boolean, Optional Delim As String) As String
Dim MyArr As Variant, a As Long, buf As String, Temp As String, t2 As String
If Delim = "" Then Delim = ";"
MyArr = Split(MyVal, Delim)
On Error Resume Next
For a = 0 To UBound(MyArr)
t2 = Left(MyArr(a), InStr(1, MyArr(a), "(") - 1)
Temp = Application.WorksheetFunction.VLookup(Trim(t2), MyRange, MyCol, False)
If Temp <> "" Then
If NoDupes Then
If InStr(1, buf, Temp) = 0 Then
buf = buf & ", " & Temp
Temp = ""
End If
Else
buf = buf & ", " & Temp
Temp = ""
End If
End If
Next a
If buf = "" Then VLOOKUPMANY = "none" Else VLOOKUPMANY = Mid(buf, 3, Len(buf))
End Function
Here's my version your macro...
Sub FormatNow()
Dim LR As Long
With Sheets("Raw")
LR = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("B:B").Insert xlShiftToRight
.Range("B3") = "Description"
.Range("B4:B" & LR).Formula = "=VLOOKUP(A4,'Item Branch'!A:B, 2, 0)"
.Range("B:B").ColumnWidth = 20
.Range("D3") = "Platform"
.Range("D4:D" & LR).Formula = "=VLOOKUPMANY(C4, Platform!$A:$B, 2, TRUE, ""; "")"
With .Range("B4:D" & LR)
.WrapText = True
.Font.Name = "Trebuchet MS"
.Font.FontStyle = "Regular"
.Font.Size = 10
.VerticalAlignment = xlBottom
End With
End With
End Sub
Bookmarks