Check the first two digits in a String in a Macro VBA function

[koteshi]

Alright, imagine I have a worksheet which looks like this:

Item No.
916.96.426
210.11.001
284.00.921
372.01.921
558.12.943
634.23.211
634.65.407
634.69.500
660.07.221
660.07.301
903.99.631
100.87.802
124.41.112
210.11.003
210.40.601

but just with 8800 Item Numbers. The first two digits of the item number indicate which group the item belongs to.

1XX.XX.XXX = furniture handles
11X.XX.XXX = golden furniture handles
2XX.XX.XXX = architectural hardware

etc.

The column next to "Item No" is supposed to tell me what kind of group this article belongs to. You can imagine that if I try to use nested IF functions I run in into some trouble as Excel 2003 doesn't supports more than 7 nested functions...

Unfortunately I have no other option than to work with Excel 2003 in my company, so I was wondering if there is some way to solve this issue with some VBA code instead.

I was thinking about IF and ELSEIF functions but I don't know how to check the first two digits/characters of a string.

Does anyone have a clue how to solve that or any better/more elegant solution?

 

[Weaver]

=left(A1,2)

for a string in A1

Thing is, you might be able to do what you need by incorporating this with a lookup table.

If you have a table elsewhere with 2 digit codes in column 1 and the descriptions in column 2, you could use the Vlookup() function to retrieve the code descriptions, no need for vb.

 

[Trevor G]

Welcome to the forum, to try and get a better handle on this you want the cell content to display what Group something belongs to based on the first 2 digits.

Do you have a table that indicates the code and also the Group details?

 

[GTO]

...but just with 8800 Item Numbers. The first two digits of the item number indicate which group the item belongs to.

1XX.XX.XXX = furniture handles
11X.XX.XXX = golden furniture handles
2XX.XX.XXX = architectural hardware...

Hi there,

If you truly can count on only the first two digits as unique, and at least as shown, only one digit in cases, then I believe you'd want to check ea two-digit first, for ea first digit, if that makes sense.

Just as a first volley:

Option Explicit
    
Sub exa2()
Dim rngData As Range
Dim aryVals As Variant
Dim i As Long
    
    With Sheet2 '<--Sub actual sheet's codename
        Set rngData = Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
        aryVals = rngData
        For i = 1 To UBound(aryVals, 1)
            Select Case True
                Case InStrRev(aryVals(i, 1), "11") = 1
                    aryVals(i, 1) = "golden furniture handles"
                Case InStrRev(aryVals(i, 1), "1") = 1
                    aryVals(i, 1) = "furniture handles"
                Case InStrRev(aryVals(i, 1), "2") = 1
                    aryVals(i, 1) = "architectural hardware"
                Case Else
                    aryVals(i, 1) = vbNullString
            End Select
        Next
                
        rngData.Offset(, 1).Value = aryVals
    End With
                
End Sub

 

[koteshi]

Thank you all for your prompt help.

@ Weaver: Nice idea. I do have a second sheet within the workbook where article groups are itemized according to the first two digits.

@ Trevor G: Nope, I'd like to have a column next to the item number column to tell me which group it belongs to. This way it will be a lot easier to check certain groups by using Auto Filters later.

@ GTO: Just ran the code. Great job and thanks a lot. Would be even greater if it could read a second table in another sheet, but your approach will decrease my work on this item list heaps. Once again, thank you.

 

[koteshi]

Alright, I've applied the code on an extract of whole table)and it seemed to work fine.
However, after further checking I realized that for some strange reason the macro acted weird.



Here's the Code:

Option Explicit
    
Sub exa2()
Dim rngData As Range
Dim aryVals As Variant
Dim i As Long
    
    With Sheet7 '<--Sub actual sheet's codename
        Set rngData = Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
        aryVals = rngData
        For i = 1 To UBound(aryVals, 1)
            Select Case True
                
                Case InStrRev(aryVals(i, 1), "00") = 1
                    aryVals(i, 1) = "Tools / Jigs"
                Case InStrRev(aryVals(i, 1), "0") = 1
                    aryVals(i, 1) = "Screws & Drilling"
                Case InStrRev(aryVals(i, 1), "1") = 1
                    aryVals(i, 1) = "Furniture Handles"
                Case InStrRev(aryVals(i, 1), "2") = 1
                    aryVals(i, 1) = "Locks, Connectors"
                Case InStrRev(aryVals(i, 1), "3") = 1
                    aryVals(i, 1) = "Hinges, Flap"
                Case InStrRev(aryVals(i, 1), "4") = 1
                    aryVals(i, 1) = "Furniture runners"
                Case InStrRev(aryVals(i, 1), "5") = 1
                    aryVals(i, 1) = "Kitchen and Bathroom fittings"
                Case InStrRev(aryVals(i, 1), "6") = 1
                    aryVals(i, 1) = "Furniture feet"
                Case InStrRev(aryVals(i, 1), "7") = 1
                    aryVals(i, 1) = "Seal profiles"
                Case InStrRev(aryVals(i, 1), "8") = 1
                    aryVals(i, 1) = "LED"
                Case InStrRev(aryVals(i, 1), "9") = 1
                    aryVals(i, 1) = "Architectural Hardware"
             
                Case Else
                    aryVals(i, 1) = vbNullString
            End Select
        Next
                
        rngData.Offset(, 1).Value = aryVals
    End With
                
End Sub

And this is what I got as a result:

<table border="0" cellpadding="0" cellspacing="0" width="326"><col style="mso-width-source:userset;mso-width-alt:3015;width:80pt" width="106"> <col style="mso-width-source:userset;mso-width-alt:6257;width:165pt" width="220"> <tbody><tr style="height:15.0pt" height="20"> <td class="xl24" style="height:15.0pt;width:80pt" height="20" width="106">Item No.</td> <td class="xl24" style="border-left:none;width:165pt" width="220">Article Group</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl24" style="height:15.0pt;border-top:none" height="20">916.96.426</td> <td class="xl24" style="border-top:none;border-left:none">　</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl24" style="height:15.0pt;border-top:none" height="20">210.11.001</td> <td class="xl24" style="border-top:none;border-left:none">Locks, Connectors</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl24" style="height:15.0pt;border-top:none" height="20">284.00.921</td> <td class="xl24" style="border-top:none;border-left:none">　</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl24" style="height:15.0pt;border-top:none" height="20">372.01.921</td> <td class="xl24" style="border-top:none;border-left:none">Hinges, Flap</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl24" style="height:15.0pt;border-top:none" height="20">558.12.943</td> <td class="xl24" style="border-top:none;border-left:none">　</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl24" style="height:15.0pt;border-top:none" height="20">634.23.211</td> <td class="xl24" style="border-top:none;border-left:none">Furniture feet</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl24" style="height:15.0pt;border-top:none" height="20">691.75.999</td> <td class="xl24" style="border-top:none;border-left:none">Furniture feet</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl24" style="height:15.0pt;border-top:none" height="20">634.65.407</td> <td class="xl24" style="border-top:none;border-left:none">　</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl24" style="height:15.0pt;border-top:none" height="20">634.69.500</td> <td class="xl24" style="border-top:none;border-left:none">　</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl24" style="height:15.0pt;border-top:none" height="20">660.07.221</td> <td class="xl24" style="border-top:none;border-left:none">　</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl24" style="height:15.0pt;border-top:none" height="20">660.07.301</td> <td class="xl24" style="border-top:none;border-left:none">　</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl24" style="height:15.0pt;border-top:none" height="20">903.99.631</td> <td class="xl24" style="border-top:none;border-left:none">　</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl24" style="height:15.0pt;border-top:none" height="20">100.87.802</td> <td class="xl24" style="border-top:none;border-left:none">Furniture Handles</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl24" style="height:15.0pt;border-top:none" height="20">124.41.784</td> <td class="xl24" style="border-top:none;border-left:none">　</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl24" style="height:15.0pt;border-top:none" height="20">210.11.003</td> <td class="xl24" style="border-top:none;border-left:none">Locks, Connectors</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl24" style="height:15.0pt;border-top:none" height="20">210.40.601</td> <td class="xl24" style="border-top:none;border-left:none">Locks, Connectors</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl24" style="height:15.0pt;border-top:none" height="20">010.40.601</td> <td class="xl24" style="border-top:none;border-left:none">　</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl24" style="height:15.0pt;border-top:none" height="20">001.40.601</td> <td class="xl24" style="border-top:none;border-left:none">Tools / Jigs</td> </tr> </tbody></table>

Strange, isn't it? Especially the Item Numbers starting with a "6". Sometimes the macro worked on them and sometimes it didn't. Any ideas?

 

[GTO]

Is the data (the item numbers) imported? Might there be non-visible lead chracter(s)?

Try =CODE(A20) where A20 refers to one of the cells that looks like it starts with a 6, but doesn't return correctly when the code runs.

 

[koteshi]

Good idea. Didn't check that before. But all the item numbers with an identical first digit return the same ASCII value (e.g. 54 for the 6XX.XX.XXX) if I use the code() function...

 

[GTO]

...Sometimes the macro worked on them and sometimes it didn't. Any ideas?

Yeh, the guy "helping" turned brain-dead...

I used InstrRev (I have utterly no idea why) when I started typing, and followed suit throughout. It should be InStr() instead.

InstrRev() was only working on the values where the number being looked for was not repeated in the string.

My apologies, a true 'blond moment' on my part.

Try:

Option Explicit
    
Sub exa2()
Dim rngData As Range
Dim aryVals As Variant
Dim i As Long
    
    With Sheet1 '<--Sub actual sheet's codename
        Set rngData = Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
        aryVals = rngData
        For i = 1 To UBound(aryVals, 1)
            Select Case True
                
                Case InStr(1, aryVals(i, 1), "00") = 1
                    aryVals(i, 1) = "Tools / Jigs"
                Case InStr(1, aryVals(i, 1), "0") = 1
                    aryVals(i, 1) = "Screws & Drilling"
                Case InStr(1, aryVals(i, 1), "1") = 1
                    aryVals(i, 1) = "Furniture Handles"
                Case InStr(1, aryVals(i, 1), "2") = 1
                    aryVals(i, 1) = "Locks, Connectors"
                Case InStr(1, aryVals(i, 1), "3") = 1
                    aryVals(i, 1) = "Hinges, Flap"
                Case InStr(1, aryVals(i, 1), "4") = 1
                    aryVals(i, 1) = "Furniture runners"
                Case InStr(1, aryVals(i, 1), "5") = 1
                    aryVals(i, 1) = "Kitchen and Bathroom fittings"
                Case InStr(1, aryVals(i, 1), "6") = 1
                    aryVals(i, 1) = "Furniture feet"
                Case InStr(1, aryVals(i, 1), "7") = 1
                    aryVals(i, 1) = "Seal profiles"
                Case InStr(1, aryVals(i, 1), "8") = 1
                    aryVals(i, 1) = "LED"
                Case InStr(1, aryVals(i, 1), "9") = 1
                    aryVals(i, 1) = "Architectural Hardware"
                Case Else
                    aryVals(i, 1) = vbNullString
            End Select
        Next
                
        rngData.Offset(, 1).Value = aryVals
    End With
                
End Sub

I bellieve it should work now...

Mark

 

[koteshi]

Great! Works like a charm now. Thanks a lot for the help at that late time of the day.
Thanks again!