Macro VBA to match zones based on certain conditions

[Fractalis]

Hello to all,

I have the table below. Maybe someone could help with this with a VBA macro. I have an Array formula that ouputs almost correct the desired output, but not completely.

In column A I have the Country Codes values and in column B corresponding description for each value (ZONE).

In Column D I have a list of numbers for which I want to look for the closest value in column A and if found put in column E the corresponding description (ZONE). The values in column E (ZONE) are the output desired for the input NUMBERS in D.

The basic condition is look the prefix, if a number in A is the prefix of a number in D (or vice versa), so the ZONE for the number in D should be the corresponding to that number in A.

Is there are more than one similar or exact matches, then the zone to select would be the first sorted ascending and if there is an exact match then zone would be that match exactly.


I hope make sense

COUNTRY CODE	ZONE		NUMBERS	ZONE
599	ANT		124	BRB45
61	AUS		12462	BRB5
124	BRB45		1246	BRB7
124622	BRB5		33	FRA1
1246	BRB7		3375012	FRA1
124623	BRB8		187635	JAM
124624	BRB92		18763044	JAM
237	CMR		23092	MUS
358	FIN		3162	NLD
33750	FRA1		49185	NOT FOUND
33751	FRA2		51078	NOT FOUND
334	FRA3		1721	SXM2
1876	JAM
230	MUS
31	NLD
65	SGP
1721	SXM2
1721	SXM4
1	USA

<tbody>
</tbody>

 

[igold]

Hi Fractalis,

This code is tested on your above graphic and works. Assuming "Country Code" is Column A and the data starts in Cell A2 and Column C is the blank Column and Columns D & E are "Numbers" & "Zone" respectively.

Sub test()


    Dim arr, cC, zN
    Dim lRow As Long, x As Long, i As Long, a As Long, E As Long
    Dim n As Integer
    
    lRow = Cells(Rows.Count, 1).End(xlUp).Row
    E = 1
    arr = Range("C2:E" & lRow)
    cC = Range("A2:B" & lRow)
    ReDim zN(1 To UBound(arr), 1 To 1)
    For x = LBound(arr) To UBound(arr)
        arr(x, 1) = Len(arr(x, 2))
    Next
    
    For i = LBound(arr) To UBound(arr)
        For a = LBound(cC) To UBound(cC)
            If Trim(arr(i, 2)) = Trim(cC(a, 1)) Then
                arr(i, 3) = cC(a, 2)
                Exit For
            End If
        Next
    Next
    
    For i = LBound(arr) To UBound(arr)
        If arr(i, 3) = Empty Then
            For a = LBound(cC) To UBound(cC)
                For n = Len(cC(a, 1)) To 1 Step -1
                    If Trim(arr(i, 2)) = Trim(Left(cC(a, 1), n)) Then
                        arr(i, 3) = cC(a, 2)
                        E = E + 1
                        GoTo nZ
                    End If
                Next
            Next
        End If
nZ:
    Next
    
     For i = LBound(arr) To UBound(arr)
        If arr(i, 3) = Empty Then
            For a = LBound(cC) To UBound(cC)
                For n = Len(arr(i, 2)) To 1 Step -1
                    If Trim(Left(arr(i, 2), n)) Like Trim(cC(a, 1)) & "*" Then
                        arr(i, 3) = cC(a, 2)
                        E = E + 1
                        GoTo nZ2
                    End If
                Next
            Next
        End If
nZ2:
    Next
    
    For i = LBound(arr) To UBound(arr)
        If Not arr(i, 2) = Empty And arr(i, 3) = Empty Then
            arr(i, 3) = "NOT FOUND"
        End If
    Next
    
  Range("C2").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
  Range("C2:C" & lRow).ClearContents
    
    
End Sub

I hope this helps...

 

[DanteAmor]

With formula


<b></b><br /><br /><table border="1" cellspacing="0" style="font-family:Calibri,Arial; font-size:11pt; background-color:#ffffff; "> <colgroup><col style="font-weight:bold; width:30px; " /><col style="width:105px;" /><col style="width:47px;" /><col style="width:23px;" /><col style="width:70px;" /><col style="width:82px;" /></colgroup><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td > </td><td >A</td><td >B</td><td >C</td><td >D</td><td >E</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >1</td><td style="background-color:#ffff00; font-weight:bold; text-align:center; ">COUNTRY CODE</td><td style="background-color:#ffff00; font-weight:bold; text-align:center; ">ZONE</td><td style="background-color:#ffff00; font-weight:bold; "> </td><td style="background-color:#ffff00; font-weight:bold; text-align:center; ">NUMBERS</td><td style="background-color:#ffff00; font-weight:bold; text-align:center; ">ZONE</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >2</td><td style="text-align:right; ">599</td><td >ANT</td><td > </td><td style="text-align:right; ">124</td><td >BRB45</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >3</td><td style="text-align:right; ">61</td><td >AUS</td><td > </td><td style="text-align:right; ">12462</td><td >BRB5</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >4</td><td style="text-align:right; ">124</td><td >BRB45</td><td > </td><td style="text-align:right; ">1246</td><td >BRB7</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >5</td><td style="text-align:right; ">124622</td><td >BRB5</td><td > </td><td style="text-align:right; ">33</td><td >FRA1</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >6</td><td style="text-align:right; ">1246</td><td >BRB7</td><td > </td><td style="text-align:right; ">3375012</td><td >FRA1</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >7</td><td style="text-align:right; ">124623</td><td >BRB8</td><td > </td><td style="text-align:right; ">187635</td><td >JAM</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >8</td><td style="text-align:right; ">124624</td><td >BRB92</td><td > </td><td style="text-align:right; ">18763044</td><td >JAM</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >9</td><td style="text-align:right; ">237</td><td >CMR</td><td > </td><td style="text-align:right; ">23092</td><td >MUS</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >10</td><td style="text-align:right; ">358</td><td >FIN</td><td > </td><td style="text-align:right; ">3162</td><td >NLD</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >11</td><td style="text-align:right; ">33750</td><td >FRA1</td><td > </td><td style="text-align:right; ">49185</td><td >NOT FOUND</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >12</td><td style="text-align:right; ">33751</td><td >FRA2</td><td > </td><td style="text-align:right; ">51078</td><td >NOT FOUND</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >13</td><td style="text-align:right; ">334</td><td >FRA3</td><td > </td><td style="text-align:right; ">1721</td><td >SXM2</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >14</td><td style="text-align:right; ">1876</td><td >JAM</td><td > </td><td > </td><td > </td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >15</td><td style="text-align:right; ">230</td><td >MUS</td><td > </td><td > </td><td > </td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >16</td><td style="text-align:right; ">31</td><td >NLD</td><td > </td><td > </td><td > </td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >17</td><td style="text-align:right; ">65</td><td >SGP</td><td > </td><td > </td><td > </td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >18</td><td style="text-align:right; ">1721</td><td >SXM2</td><td > </td><td > </td><td > </td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >19</td><td style="text-align:right; ">1721</td><td >SXM4</td><td > </td><td > </td><td > </td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >20</td><td style="text-align:right; ">1</td><td >USA</td><td > </td><td > </td><td > </td></tr></table><br /><table style="font-family:Arial; font-size:10pt; border-style: groove ;border-color:#00ff00;background-color:#fffcf9; color:#000000; "><tr><td ><b></b></td></tr><tr><td ><table border = "1" cellspacing="0" cellpadding="2" style="font-family:Arial; font-size:9pt;"><tr style="background-color:#cacaca; font-size:10pt;"><td >Cell</td><td >Array Formula</td></tr><tr><td >E2</td><td >{=IFERROR(VLOOKUP(D2,$A$2:$B$20,2,0),IFERROR(INDEX($B$2:$B$20,MATCH(""&D2,LEFT($A$2:$A$20,LEN(D2)),0)),IFERROR(INDEX($B$2:$B$20,MIN(IF(--ISNUMBER(SEARCH($A$2:$A$20,LEFT(D2,LEN($A$2:$A$20)))),ROW($B$2:$B$20)))-1),"NOT FOUND")))}</td></tr></td></tr></table></td></tr></table> <br /><br />

 

[DanteAmor]

With VBA

Sub match_zones()
   Dim a As Range, d As Range, f As Range, v1 As Range, v2 As Range
   
   Set a = Range("A2", Range("A" & Rows.Count).End(xlUp))
   Set d = Range("D2", Range("D" & Rows.Count).End(xlUp))
   For Each v1 In d
      Set f = a.Find(v1.Value, LookIn:=xlValues, lookat:=xlWhole)
      If Not f Is Nothing Then
         [COLOR=#0000ff]v1.Offset(, 1).Value[/COLOR] = f.Offset(, 1).Value
      Else
         Set f = a.Find(v1.Value & "*", LookIn:=xlValues, lookat:=xlWhole)
         If Not f Is Nothing Then
            [COLOR=#0000ff]v1.Offset(, 1).Value[/COLOR] = f.Offset(, 1).Value
         Else
            [COLOR=#0000ff]v1.Offset(, 1).Value[/COLOR] = Evaluate("=IFERROR(INDEX(" & a.Offset(0, 1).Address & ",MIN(IF(--ISNUMBER(SEARCH(" & a.Address & _
               ",LEFT(" & v1.Value & ",LEN(" & a.Address & ")))),ROW(" & a.Offset(0, 1).Address & ")))-1),""NOT FOUND"")")
         End If
      End If
   Next
End Sub

 

[Fractalis]

Hello Igold/Hola Dante,

Many thanks both for answer my question and your solutions. Both work for the sample input, only one thing I see.

For example if in column D (NUMBERS) there is a value 12462, when trying to match that number with values in column A (COUNTRY CODES) there are 3 possible matches (3 values that have as prefix 12462) 124622, 124623 and 124624. Now supposed the ZONES for each one are as below:

124622 --> ABD
124624 --> ABR
124624 --> ABA

Then if we sort ascending the 3 matched ZONES the order is ABA, ABD, ABR.

In this case the ZONE to select for NUMBER=12462 should be the first one sorted ascending = ABA.

I hope make sense.

Thanks for the help so far.

Regards

 

[DanteAmor]

Works! Just sort the data by the ZONE column and review the result

 

[Fractalis]

Works! Just sort the data by the ZONE column and review the result

Hola Dante,

Yes, you're rigth. It works sorting by ZONE column, but since the structure of actual data i would like to avoid change the original order. If it is too much complicated to obtain the same results indepentdently if columns are sorted or not, then I'll use it in this way that it helps a lot actually.

Thanks again.

 

[DanteAmor]

With my macro you have an opportunity, sort the data, execute the macro and then sort the data to its original position.

 

[Fractalis]

With my macro you have an opportunity, sort the data, execute the macro and then sort the data to its original position.

Muchas gracias Dante for the help.

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.