VBA for numbers within Ranges.

[Livin404]

Greetings I have had tremendous help in this area, with VLookUPs. Now I have 5 digits with the first four being numbers. I could make a massive Vlookup listing the numbers in a single column that would require thousand of entries. Please refer to the image. I can I adjust the VBA provided by "Snakehips". The X can be any letter, it cannot be another number.

Private Sub USER_BRANCH()
   Dim i As Long, n As Variant
   Dim ShtAD, Sht72H, LUrng As Range
   Dim slash, GotIt As String
  
   Set ShtAD = Sheets("AirDrop")
   Set Sht72H = Sheets("72 Hr")
   Set LUrng = ShtAD.Range("A15:B23")
  
   Lastr = Sht72H.Range("A" & Rows.Count).End(xlUp).Row
  
    For i = 1 To Lastr
        slash = ""
        GotIt = ""
         n = Mid(Sht72H.Cells(i, 1).Value, 5, 5)
      
 If IsNumeric(n) Then n = CLng(n)
       On Error Resume Next
            If Not Sht72H.Cells(i, 6).Value = "" Then slash = " / "
            GotIt = Application.WorksheetFunction.VLookup(n, LUrng, 2, 0)
            If Not GotIt = "" Then
                Sht72H.Cells(i, 6).Value = Sht72H.Cells(i, 6).Value & slash & GotIt
            End If
    Next i
    On Error GoTo 0
End Sub

 

[johnnyL]

@Livin404 again you weren't to specific to what exactly you were wanting other than to check for 4 numbers and a letter.

With that in mind I came up with following for the 'Air Drop' sheet:

Livin04LookupTableVersion5Characters.xlsm
	A	B
1	LookUp	Return
2	1000	1000X-2999X
3	2999
4	3000	3000X-4999X
5	4999
6	5000	5000X-5999X
7	5999
8	6000	6000X-6999X
9	6999
10	7000	7000X-7499X
11	7499
12	7500	7500X-7999X
13	7999
14	8000	8000X-8499X
15	8499
16	8500	8500X-8999X
17	8999
18	9000	9000X-9499X
19	9499
20	9500	9500X-9999X
21	9999
Air Drop

Private Sub USER_BRANCHv2()
'
    Dim First4NumbersOf72Hr As Double
    Dim LastRow72Hr         As Long
    Dim LastRowAirDrop      As Long
    Dim RowCounter72Hr      As Long
    Dim RowCounterAirDrop   As Long
    Dim StringToSearchFor   As String
'
    LastRow72Hr = Sheets("72 Hr").Range("A" & Rows.Count).End(xlUp).Row
    LastRowAirDrop = Sheets("Air Drop").Range("A" & Rows.Count).End(xlUp).Row
 
    For RowCounter72Hr = 1 To LastRow72Hr                               ' Loop through each cell in column A to check against the table of values
        If Len(Sheets("72 Hr").Range("A" & RowCounter72Hr).Value) = 5 Then                                  ' Check to see if the string = 5 characters
            If IsNumeric(Left(Sheets("72 Hr").Range("A" & RowCounter72Hr).Value, 4)) = True Then            '   Check to see if first 4 characters are numbers
                If IsThisALetter(Mid(Sheets("72 Hr").Range("A" & RowCounter72Hr).Value, 5, 1)) = True Then  '     Check to see if 5th chacter is a letter
                    First4NumbersOf72Hr = Val(Left(Sheets("72 Hr").Range("A" & RowCounter72Hr).Value, 4))   '       Convert the first 4 characters from string to numeric
'
                    For RowCounterAirDrop = 2 To LastRowAirDrop - 1 Step 2
                        If First4NumbersOf72Hr >= Sheets("Air Drop").Range("A" & RowCounterAirDrop).Value And First4NumbersOf72Hr <= Sheets("Air Drop").Range("A" & RowCounterAirDrop + 1).Value Then
                            If Sheets("72 Hr").Range("F" & RowCounter72Hr).Value = "" Then
                                Sheets("72 Hr").Range("F" & RowCounter72Hr).Value = Sheets("Air Drop").Range("B" & RowCounterAirDrop).Value
                                Exit For
                            Else
                                Sheets("72 Hr").Range("F" & RowCounter72Hr).Value = Sheets("72 Hr").Range("F" & RowCounter72Hr).Value & "/" & Sheets("Air Drop").Range("B" & RowCounterAirDrop).Value
                                Exit For
                            End If
                        End If
                    Next
                End If
            End If
        End If
    Next
End Sub


Function IsThisALetter(TestCharacter As String) As Boolean
'
'   This function takes a single character as input and checks to see if it is a letter. Results in True or False
'       You can use it in a cell formula ex. =IsThisALetter(A1), where cell A1 is a single character.
'
    IsThisALetter = Asc(UCase(TestCharacter)) > 64 And Asc(UCase(TestCharacter)) < 91    'Is the character a letter?
End Function

Which resulted in the following for the '72 Hr' sheet that has the values to check column (A) and the Results column (F):

Livin04LookupTableVersion5Characters.xlsm
	A	B	C	D	E	F
1	2999x					Something/1000X-2999X
2	1000X					1000X-2999X
3	0999x					Something
4	1234X567
5	3000x					3000X-4999X
6	4999X					3000X-4999X
7	5000X					5000X-5999X
8	5999x					5000X-5999X
9	6000x					6000X-6999X
10	6999X					6000X-6999X
11	7000x					7000X-7499X
12	7499x					7000X-7499X
13	7500X					7500X-7999X
14	7999x					7500X-7999X
15	80000
16	8000x					8000X-8499X
17	8000#
18	8499X					8000X-8499X
19	8500x					8500X-8999X
20	8500-
21	8999X					8500X-8999X
22	9000x					9000X-9499X
23	9499X					9000X-9499X
24	9500x					9500X-9999X
25	9999x					9500X-9999X
72 Hr

Let us know how it goes.

 

[johnnyL]

Here is an alternative version if you only want to have the table you posted in the 'Air Drop' sheet column A:

Livin04LookupTableVersion5CharactersAlternateV1.xlsm
	A
1	LookUp
2	1000X-2999X
3	3000X-4999X
4	5000X-5999X
5	6000X-6999X
6	7000X-7499X
7	7500X-7999X
8	8000X-8499X
9	8500X-8999X
10	9000X-9499X
11	9500X-9999X
12
Air Drop

And the code to utilize that:

Private Sub USER_BRANCHv2AlternateV1()
'
    Dim First4NumbersOf72Hr As Double
    Dim LastRow72Hr         As Long
    Dim LastRowAirDrop      As Long
    Dim RowCounter72Hr      As Long
    Dim RowCounterAirDrop   As Long
'
    LastRow72Hr = Sheets("72 Hr").Range("A" & Rows.Count).End(xlUp).Row
    LastRowAirDrop = Sheets("Air Drop").Range("A" & Rows.Count).End(xlUp).Row
 
    For RowCounter72Hr = 1 To LastRow72Hr                                       ' Loop through each cell in column A to check against the table of values
        If Len(Sheets("72 Hr").Range("A" & RowCounter72Hr).Value) = 5 Then                                  ' Check to see if the string = 5 characters
            If IsNumeric(Left(Sheets("72 Hr").Range("A" & RowCounter72Hr).Value, 4)) = True Then            '   Check to see if first 4 characters are numbers
                If IsThisALetter(Mid(Sheets("72 Hr").Range("A" & RowCounter72Hr).Value, 5, 1)) = True Then  '     Check to see if 5th chacter is a letter
                    First4NumbersOf72Hr = Val(Left(Sheets("72 Hr").Range("A" & RowCounter72Hr).Value, 4))   '       Convert the first 4 characters from string to numeric
'
                    For RowCounterAirDrop = 2 To LastRowAirDrop                 ' Loop through each cell in column A to check for a match of high and Low values
                        If First4NumbersOf72Hr >= Val(Left(Sheets("Air Drop").Range("A" & RowCounterAirDrop).Value, 4)) And _
                          First4NumbersOf72Hr <= Val(Mid(Sheets("Air Drop").Range("A" & RowCounterAirDrop).Value, 7, 4)) Then   ' If match found then ...
                            If Sheets("72 Hr").Range("F" & RowCounter72Hr).Value = "" Then                                      '   Is the cell in column F "" ?
                                Sheets("72 Hr").Range("F" & RowCounter72Hr).Value = Sheets("Air Drop").Range("A" & RowCounterAirDrop).Value ' Yes, set the cell value
                                Exit For                                                                                                    ' Exit this For Loop
                            Else
                                Sheets("72 Hr").Range("F" & RowCounter72Hr).Value = _
                                  Sheets("72 Hr").Range("F" & RowCounter72Hr).Value & "/" & Sheets("Air Drop").Range("A" & RowCounterAirDrop).Value ' Append a value
                                Exit For                                                                                                    ' Exit this For Loop
                            End If
                        End If
                    Next
                End If
            End If
        End If
    Next
End Sub


Function IsThisALetter(TestCharacter As String) As Boolean
'
'   This function takes a single character as input and checks to see if it is a letter. Results in True or False
'       You can use it in a cell formula ex. =IsThisALetter(A1), where cell A1 is a single character.
'
    IsThisALetter = Asc(UCase(TestCharacter)) > 64 And Asc(UCase(TestCharacter)) < 91    'Is the character a letter?
End Function

The results are the same as in my previous post here for the '72 Hr' sheet that has the values to check column (A) and the Results column (F).

 

[Livin404]

Thank you for getting back, I’ll test it next time I’m on my laptop. Just so you know, though the image doesn’t show there are text values in the description. For exam a number like 3677A would have gotten whatever I had listed in the second row of Column B. The X shown would be a letter and the number would fall within the given range in Column A.

 

[johnnyL]

Thank you for getting back, I’ll test it next time I’m on my laptop. Just so you know, though the image doesn’t show there are text values in the description. For exam a number like 3677A would have gotten whatever I had listed in the second row of Column B. The X shown would be a letter and the number would fall within the given range in Column A.

Ok, here is the code to handle the 'Air Drop' sheet with the range in Column A and the Description in column B:

Livin04LookupTableVersion5CharactersAlternateV2.xlsm
	A	B
1	LookUp	Description
2	1000X-2999X	Text2
3	3000X-4999X	Text3
4	5000X-5999X	Text4
5	6000X-6999X	Text5
6	7000X-7499X	Text6
7	7500X-7999X	Text7
8	8000X-8499X	Text8
9	8500X-8999X	Text9
10	9000X-9499X	Text10
11	9500X-9999X	Text11
12
Air Drop

Private Sub USER_BRANCHv2AlternateV2()
'
    Dim First4NumbersOf72Hr As Double
    Dim LastRow72Hr         As Long
    Dim LastRowAirDrop      As Long
    Dim RowCounter72Hr      As Long
    Dim RowCounterAirDrop   As Long
'
    LastRow72Hr = Sheets("72 Hr").Range("A" & Rows.Count).End(xlUp).Row
    LastRowAirDrop = Sheets("Air Drop").Range("A" & Rows.Count).End(xlUp).Row
 
    For RowCounter72Hr = 1 To LastRow72Hr                                       ' Loop through each cell in column A to check against the table of values
        If Len(Sheets("72 Hr").Range("A" & RowCounter72Hr).Value) = 5 Then                                  ' Check to see if the string = 5 characters
            If IsNumeric(Left(Sheets("72 Hr").Range("A" & RowCounter72Hr).Value, 4)) = True Then            '   Check to see if first 4 characters are numbers
                If IsThisALetter(Mid(Sheets("72 Hr").Range("A" & RowCounter72Hr).Value, 5, 1)) = True Then  '     Check to see if 5th chacter is a letter
                    First4NumbersOf72Hr = Val(Left(Sheets("72 Hr").Range("A" & RowCounter72Hr).Value, 4))   '       Convert the first 4 characters from string to numeric
'
                    For RowCounterAirDrop = 2 To LastRowAirDrop                 ' Loop through each cell in column A to check for a match of high and Low values
                        If First4NumbersOf72Hr >= Val(Left(Sheets("Air Drop").Range("A" & RowCounterAirDrop).Value, 4)) And _
                          First4NumbersOf72Hr <= Val(Mid(Sheets("Air Drop").Range("A" & RowCounterAirDrop).Value, 7, 4)) Then   ' If match found then ...
                            If Sheets("72 Hr").Range("F" & RowCounter72Hr).Value = "" Then                                      '   Is the cell in column F "" ?
                                Sheets("72 Hr").Range("F" & RowCounter72Hr).Value = Sheets("Air Drop").Range("B" & RowCounterAirDrop).Value ' Yes, set the cell value
                                Exit For                                                                                                    ' Exit this For Loop
                            Else
                                Sheets("72 Hr").Range("F" & RowCounter72Hr).Value = _
                                  Sheets("72 Hr").Range("F" & RowCounter72Hr).Value & "/" & Sheets("Air Drop").Range("B" & RowCounterAirDrop).Value ' Append a value
                                Exit For                                                                                                    ' Exit this For Loop
                            End If
                        End If
                    Next
                End If
            End If
        End If
    Next
End Sub


Function IsThisALetter(TestCharacter As String) As Boolean
'
'   This function takes a single character as input and checks to see if it is a letter. Results in True or False
'       You can use it in a cell formula ex. =IsThisALetter(A1), where cell A1 is a single character.
'
    IsThisALetter = Asc(UCase(TestCharacter)) > 64 And Asc(UCase(TestCharacter)) < 91    'Is the character a letter?
End Function

And the results on the '72 Hr' sheet:

Livin04LookupTableVersion5CharactersAlternateV2.xlsm
	A	B	C	D	E	F
1	2999x					Something/Text2
2	1000X					Text2
3	0999x					Something
4	1234X567
5	3000x					Text3
6	4999X					Text3
7	5000X					Text4
8	5999x					Text4
9	6000x					Text5
10	6999X					Text5
11	7000x					Text6
12	7499x					Text6
13	7500X					Text7
14	7999x					Text7
15	80000
16	8000x					Text8
17	8000#
18	8499X					Text8
19	8500x					Text9
20	8500-
21	8999X					Text9
22	9000x					Text10
23	9499X					Text10
24	9500x					Text11
25	9999x					Text11
26
72 Hr

 

[Livin404]

Thank you, I will test it properly soon. I had a chance to read the comments. I'm afraid my target characters from a 12 digit text string, are characters 5-9. I definitely understand your frustration. Yet again between my thought process and posting things get a little muddled.

 

[johnnyL]

So you are now saying that you have a 12 character text string that you want to test characters 5,6,7,8 for numbers & character 9 for a letter? The rest of the characters to the left of 5 thru 9 and to the right don't matter?

 

[johnnyL]

So you are now saying that you have a 12 character text string that you want to test characters 5,6,7,8 for numbers & character 9 for a letter? The rest of the characters to the left of 5 thru 9 and to the right don't matter?

Assuming my previous post is correct, that brings us to the following:

Livin04LookupTableVersion5CharactersAlternateV3.xlsm
	A	B
1	LookUp	Description
2	1000X-2999X	Text2
3	3000X-4999X	Text3
4	5000X-5999X	Text4
5	6000X-6999X	Text5
6	7000X-7499X	Text6
7	7500X-7999X	Text7
8	8000X-8499X	Text8
9	8500X-8999X	Text9
10	9000X-9499X	Text10
11	9500X-9999X	Text11
12
Air Drop

Code you could use:

Private Sub USER_BRANCHv2AlternateV3()
'
    Dim Characters5Thru8Of72Hr  As Double
    Dim LastRow72Hr             As Long
    Dim LastRowAirDrop          As Long
    Dim RowCounter72Hr          As Long
    Dim RowCounterAirDrop       As Long
'
    LastRow72Hr = Sheets("72 Hr").Range("A" & Rows.Count).End(xlUp).Row
    LastRowAirDrop = Sheets("Air Drop").Range("A" & Rows.Count).End(xlUp).Row
 
    For RowCounter72Hr = 1 To LastRow72Hr                                       ' Loop through each cell in column A to check against the table of values
        If Len(Sheets("72 Hr").Range("A" & RowCounter72Hr).Value) = 12 Then                                     ' Check to see if the string = 12 characters
            If IsNumeric(Mid(Sheets("72 Hr").Range("A" & RowCounter72Hr).Value, 5, 4)) = True Then              '   Check to see if 5th-8th characters are numbers
                If IsThisALetter(Mid(Sheets("72 Hr").Range("A" & RowCounter72Hr).Value, 9, 1)) = True Then      '     Check to see if 9th chacter is a letter
                    Characters5Thru8Of72Hr = Val(Mid(Sheets("72 Hr").Range("A" & RowCounter72Hr).Value, 5, 4))  '       Convert the 5th-8th characters from string to numeric
'
                    For RowCounterAirDrop = 2 To LastRowAirDrop                 ' Loop through each cell in column A to check for a match of high and Low values
                        If Characters5Thru8Of72Hr >= Val(Left(Sheets("Air Drop").Range("A" & RowCounterAirDrop).Value, 4)) And _
                          Characters5Thru8Of72Hr <= Val(Mid(Sheets("Air Drop").Range("A" & RowCounterAirDrop).Value, 7, 4)) Then    ' If match found then ...
                            If Sheets("72 Hr").Range("F" & RowCounter72Hr).Value = "" Then                                          '   Is the cell in column F "" ?
                                Sheets("72 Hr").Range("F" & RowCounter72Hr).Value = Sheets("Air Drop").Range("B" & RowCounterAirDrop).Value ' Yes, set the cell value
                                Exit For                                                                                                    ' Exit this For Loop
                            Else
                                Sheets("72 Hr").Range("F" & RowCounter72Hr).Value = _
                                  Sheets("72 Hr").Range("F" & RowCounter72Hr).Value & "/" & Sheets("Air Drop").Range("B" & RowCounterAirDrop).Value ' Append a value
                                Exit For                                                                                                    ' Exit this For Loop
                            End If
                        End If
                    Next
                End If
            End If
        End If
    Next
End Sub


Function IsThisALetter(TestCharacter As String) As Boolean
'
'   This function takes a single character as input and checks to see if it is a letter. Results in True or False
'       You can use it in a cell formula ex. =IsThisALetter(A1), where cell A1 is a single character.
'
    IsThisALetter = Asc(UCase(TestCharacter)) > 64 And Asc(UCase(TestCharacter)) < 91    'Is the character a letter?
End Function

And the Test column A Data/Column F results on the '72 Hr' sheet:

Livin04LookupTableVersion5CharactersAlternateV3.xlsm
	A	B	C	D	E	F
1	ABCD2999x123					Something/Text2
2	ABCD1000X123					Text2
3	ABCD0999x123					Something
4	ABCD1234X5678
5	ABCD3000x123					Text3
6	ABCD4999X123					Text3
7	ABCD5000X123					Text4
8	ABCD5999x123					Text4
9	ABCD6000x123					Text5
10	ABCD6999X123					Text5
11	ABCD7000x123					Text6
12	ABCD7499x123					Text6
13	ABCD7500X123					Text7
14	ABCD7999x123					Text7
15	80000
16	ABCD8000x123					Text8
17	ABCD8000#123
18	ABCD8499X123					Text8
19	ABCD8500x123					Text9
20	ABCD8500-123
21	ABCD8999X123					Text9
22	ABCD9000x123					Text10
23	ABCD9499X123					Text10
24	ABCD9500x123					Text11
25	ABCD9999x123					Text11
26
72 Hr