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

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.

1. 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.
2. 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.
3. 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.
4. 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.
5. 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.
6. 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".
7. Other cell formatting could be added without much effort because each cell is already individually named. More properties can be added easily.