How to get multiple results with one vlookup in VBA, Where vlookup is the part of the whole string (vlookup value) - vba

Question

I have 3 sheets, in sheet one I have a column "Register Codes" and I have extracted the unique codes in next column. Please check the below image.
Based on these unique codes, sub-codes are allocated in sheet 2. please check the below image.
Now what I am trying here is that in sheet 3 I need every "Register code" with the relevant "sub-code" which is allocated in sheet2 based on the "unique ID" given in Sheet1. please check the below image for expected output.
I have been using various combinations of formulas but could not get a proper solution. What is the best way to do it in VBA as I just started learning in this field.

Answer 1

Subject to a few conditions the following code will do what you want. Install it in a standard code module (by default "Module1", but you can name it as you like) in the workbook where you have your data.
Option Explicit
Enum Nws ' Worksheet navigation
NwsFirstDataRow = 2 ' presumed the same for all worksheets
NwsCode = 1 ' 1 = column A (change as required)
NwsSubCode ' No value means previous + 1
NwsNumer
End Enum
Sub NumerList()
' 05 Apr 2017
Dim Wb As Workbook ' all sheets are in the same workbook
Dim WsCodes As Worksheet ' Register codes
Dim WsNum As Worksheet ' Sub-code values
Dim WsOut As Worksheet ' Output worksheet
Dim RegName As String, RegCode As String
Dim Sp() As String
Dim Rs As Long ' Source row in WsNum
Dim Rt As Long ' Target row in WsOut
Dim R As Long, Rl As Long ' rows / Last row in WsCodes
Set Wb = ActiveWorkbook ' Make sure it is active!
Set WsCodes = Wb.Worksheets("Reg Codes") ' Change name to your liking
Set WsNum = Wb.Worksheets("Code Values") ' Change name to your liking
On Error Resume Next
Set WsOut = Wb.Worksheets("Output") ' Change name to your liking
If Err Then
Set WsOut = Wb.Worksheets.Add(After:=WsNum)
WsOut.Name = "Output" ' create the worksheet if it doesn't exist
End If
On Error GoTo 0
Rt = NwsFirstDataRow
With WsCodes
Rl = .Cells(.Rows.Count, NwsCode).End(xlUp).Row
For R = NwsFirstDataRow To Rl
RegName = .Cells(R, NwsCode).Value
Sp = Split(RegName, "-")
If UBound(Sp) > 1 Then ' must find at least 2 dashes
RegCode = Trim(Sp(1))
Else
RegCode = ""
End If
If Len(RegCode) Then
On Error Resume Next
Rs = WorksheetFunction.Match(RegCode, WsNum.Columns(NwsCode), 0)
If Err Then Rs = 0
On Error GoTo 0
If Rs Then
Do
WsOut.Cells(Rt, NwsCode).Value = RegName
WsOut.Cells(Rt, NwsSubCode).Value = WsNum.Cells(Rs, NwsSubCode).Value
WsOut.Cells(Rt, NwsNumer).Value = WsNum.Cells(Rs, NwsNumer).Value
Rt = Rt + 1
Rs = Rs + 1
Loop While WsNum.Cells(Rs, NwsCode).Value = RegCode
Else
RegCode = ""
End If
End If
If Len(RegCode) = 0 Then
WsOut.Cells(Rt, NwsCode).Value = RegName
WsOut.Cells(Rt, NwsSubCode).Value = "No sub-code found"
Rt = Rt + 1
End If
Next R
End With
End Sub
And here are the conditions.
All 3 sheets must be in the same workbook. If you have them in different workbooks the code must be adapted to handle more than one workbook.
The two worksheets with data must exist. They must be named as the code prescribes or the code must be modified to match the names they have. The same goes for the Output worksheet, but that sheet will be created by the code if it doesn't exist. You can change its name in the code.
The enumeration at the top of the code presumes that all 3 sheets are identically formatted with no data in row 1 (captions) and data in columns A, B and C. Changes aren't difficult but must be made if you want a different input or output. You can change the columns in the existing code by assigning other values to the columns in the enum, but the code requires the same arrangement in all sheets.
The extracted codes in the Codes sheet aren't used. The code does its own extraction. It will mark an error in the output list if a code can't be extracted or if it isn't found in the Sub-code list.
The sub-codes in the Numer sheet must be sorted like the picture you posted. The code will look for the first occurrence of "image" and find the subcodes in the following rows while the code is "image" in column A. It will not find further occurrences of "image" that might follow after an intermission.
The code doesn't do any colouring. Adding it wouldn't be difficult, but you would have to specify some rules, such as "20 different colours for the first 20 codes and then repeat the same sequence".
Other cell formatting could be added without much effort because each cell is already individually named. More properties can be added easily.