Using one VBA instead of 13.

Livin404

Active Member
Joined
Jan 7, 2019
Messages
482
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Greeings I was just help a short while ago where I was to extract two letter from a string then get a respone. However, I think I could use a VBA and save myself a dozen extra codes.
Here Is a VBA I'm starting with for a VLOOKUP
VBA Code:
Private Sub Air_Drop()
   Dim i As Long, n As Variant
    For i = 1 To Split(Worksheets("72 Hr").UsedRange.Address, "$")(4)
         n = Right(Worksheets("72 Hr").Cells(i, 8).Value, 3)
       If IsNumeric(n) Then n = CLng(n)
        
        Worksheets("72 Hr").Cells(i, 1).Value = _
        Application.WorksheetFunction.VLookup(n, Worksheets("Air Drop").Range("A:B"), 2, 1)
    Next i
End Sub

I will have a 12 alpanumeric code in Column A the number of rows can vary, on sheet "72 Hr". I want to look at "Only" Characters 6 & 7. Then I will have the code check the Sheet "Air Drop" A1:B13. The result will go Column F on sheet 72 Hr. If there is nothing in F then the result will be placed. If there is already text then a "/" folllowed by whatever the result was from Column B on the page "Air Drop".
Below is just an example, the word CARGO ACCFT is just a place holder. I don't know how to show a variable.

VBA Code:
If ActiveSheet.Range("F" & i) = "" Then
 ActiveSheet.Range("F" & i) = "CARGO ACFT"
      Else
ActiveSheet.Range("F" & i) = ActiveSheet.Range("F" & i) & " // CARGO ACFT"
    End If
     End Select
    Next i
End Sub
 

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
1,846
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
@Livin404 Thank you for providing the code that you are using. It would be better if you also provide samples of the data that you have as well as what you are wanting for the result to look like afterwords.
 

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
1,846
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
As far as the use of variables, see if the following helps:

VBA Code:
'   Variable lesson
'
    Dim SampleStringVariableName    As String
    Dim SampleNumberVariableName    As Integer
'
    SampleStringVariableName = "CARGO ACFT"
    SampleNumberVariableName = 5
'
    If ActiveSheet.Range("F" & i) = "" Then
        ActiveSheet.Range("F" & i) = SampleStringVariableName                                       ' This equates to 'CARGO ACFT'
        ActiveSheet.Range("G" & i) = SampleNumberVariableName                                       ' This equates to 5
    Else
        ActiveSheet.Range("F" & i) = ActiveSheet.Range("F" & i) & "/" & SampleStringVariableName    ' This equates to '/CARGO ACFT'
    End If
 

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
1,846
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
Forgot to mention, my previous post here was only for informative purposes, not meant to be considered as a solution to anything in this thread,
 

Snakehips

Well-known Member
Joined
May 17, 2009
Messages
5,390
Office Version
  1. 365
  2. 2010
Platform
  1. Windows

ADVERTISEMENT

@Livin404 Given my interpretation of what you describe, is this what you want?
Lookup table in Air Drop
MRXLMAY21.xlsm
AB
1LookUpReturn
211Bee1
322Bee2
433Bee3
544Bee4
655Bee5
766Bee6
877Bee7
988Bee8
1099Bee9
11110Bee10
12121Bee11
13132Bee12
14143Bee13
Air Drop


72 Hr after running code.

MRXLMAY21.xlsm
ABCDEF
1abcd5119xxxxExisting Text / Bee1
2abcd5229xxxxBee2
3abcd5339xxxxBee3
4abcd5449xxxxBeeStuff / Bee4
72 Hr


Code

VBA Code:
Private Sub Air_Drop()
   Dim i As Long, n As Variant
   Dim ShtAD, Sht72H, LUrng As Range
   Dim slash As String
   
   Set ShtAD = Sheets("Air Drop")
   Set Sht72H = Sheets("72 Hr")
   Set LUrng = ShtAD.Range("A1:B13")
   
   Lastr = Sht72H.Range("A" & Rows.Count).End(xlUp).row
   
    For i = 1 To Lastr
        slash = ""
         n = Mid(Sht72H.Cells(i, 1).Value, 6, 2)
       If IsNumeric(n) Then n = CLng(n)
        If Not Sht72H.Cells(i, 6).Value = "" Then slash = " / "
        Sht72H.Cells(i, 6).Value = _
        Sht72H.Cells(i, 6).Value & slash & Application.WorksheetFunction.VLookup(n, LUrng, 2)
    Next i
End Sub

Hope that helps.
 

Livin404

Active Member
Joined
Jan 7, 2019
Messages
482
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
@Livin404 Given my interpretation of what you describe, is this what you want?
Lookup table in Air Drop
MRXLMAY21.xlsm
AB
1LookUpReturn
211Bee1
322Bee2
433Bee3
544Bee4
655Bee5
766Bee6
877Bee7
988Bee8
1099Bee9
11110Bee10
12121Bee11
13132Bee12
14143Bee13
Air Drop


72 Hr after running code.

MRXLMAY21.xlsm
ABCDEF
1abcd5119xxxxExisting Text / Bee1
2abcd5229xxxxBee2
3abcd5339xxxxBee3
4abcd5449xxxxBeeStuff / Bee4
72 Hr


Code

VBA Code:
Private Sub Air_Drop()
   Dim i As Long, n As Variant
   Dim ShtAD, Sht72H, LUrng As Range
   Dim slash As String
  
   Set ShtAD = Sheets("Air Drop")
   Set Sht72H = Sheets("72 Hr")
   Set LUrng = ShtAD.Range("A1:B13")
  
   Lastr = Sht72H.Range("A" & Rows.Count).End(xlUp).row
  
    For i = 1 To Lastr
        slash = ""
         n = Mid(Sht72H.Cells(i, 1).Value, 6, 2)
       If IsNumeric(n) Then n = CLng(n)
        If Not Sht72H.Cells(i, 6).Value = "" Then slash = " / "
        Sht72H.Cells(i, 6).Value = _
        Sht72H.Cells(i, 6).Value & slash & Application.WorksheetFunction.VLookup(n, LUrng, 2)
    Next i
End Sub

Hope that helps.
Thank you so much! I know it's going to work. I think I need just one more little component, and that is to insert a statement like "else" because not every group of 12 codes will have those combinations for characters 6 & 7. Basically if there is nothing in that VLookUp I need it to be ignored. I'm sorry I didn't mention it, but I know it is going to be perfect if I can work that out.
 

Livin404

Active Member
Joined
Jan 7, 2019
Messages
482
Office Version
  1. 365
  2. 2019
Platform
  1. Windows

ADVERTISEMENT

@Livin404 Given my interpretation of what you describe, is this what you want?
Lookup table in Air Drop
MRXLMAY21.xlsm
AB
1LookUpReturn
211Bee1
322Bee2
433Bee3
544Bee4
655Bee5
766Bee6
877Bee7
988Bee8
1099Bee9
11110Bee10
12121Bee11
13132Bee12
14143Bee13
Air Drop


72 Hr after running code.

MRXLMAY21.xlsm
ABCDEF
1abcd5119xxxxExisting Text / Bee1
2abcd5229xxxxBee2
3abcd5339xxxxBee3
4abcd5449xxxxBeeStuff / Bee4
72 Hr


Code

VBA Code:
Private Sub Air_Drop()
   Dim i As Long, n As Variant
   Dim ShtAD, Sht72H, LUrng As Range
   Dim slash As String
  
   Set ShtAD = Sheets("Air Drop")
   Set Sht72H = Sheets("72 Hr")
   Set LUrng = ShtAD.Range("A1:B13")
  
   Lastr = Sht72H.Range("A" & Rows.Count).End(xlUp).row
  
    For i = 1 To Lastr
        slash = ""
         n = Mid(Sht72H.Cells(i, 1).Value, 6, 2)
       If IsNumeric(n) Then n = CLng(n)
        If Not Sht72H.Cells(i, 6).Value = "" Then slash = " / "
        Sht72H.Cells(i, 6).Value = _
        Sht72H.Cells(i, 6).Value & slash & Application.WorksheetFunction.VLookup(n, LUrng, 2)
    Next i
End Sub

Hope that helps.
I just wanted to add I can say the problem just mentioned is the reason, but I'm only guessing since it did perform as I hoped until it came across a that none of the letters didn't match. I provided an image. Thank you again so much!
Capture.JPG
 

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
1,846
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
@Livin404 The following is probably more what you are used to:

VBA Code:
Private Sub Air_Drop()
   Dim RowCounter As Long
   Dim StringToSearchFor    As String
'
   LastRow = Sheets("72 Hr").Range("A" & Rows.Count).End(xlUp).Row
 
    For RowCounter = 1 To LastRow
        StringToSearchFor = Mid(Sheets("72 Hr").Range("A" & RowCounter).Value, 6, 2)                 ' Get 6th and 7th character from Column A cell sheet 72 Hr
'
        If StringToSearchFor = Sheets("Air Drop").Range("A" & (RowCounter + 1)).Value Then
            If Sheets("72 Hr").Range("F" & RowCounter).Value = "" Then
                Sheets("72 Hr").Range("F" & RowCounter).Value = "CARGO ACFT"
            Else
                Sheets("72 Hr").Range("F" & RowCounter).Value = Sheets("72 Hr").Range("F" & RowCounter).Value & "/CARGO ACFT"
            End If
        End If
    Next
End Sub

This code will use a 'vlookup' style of code without an actual vlookup formula.

The data in the B column of Sheets("Air Drop") is also not necessary with this code.

BTW, The ignores are included that you asked about previously. ;)
 
Last edited:

Livin404

Active Member
Joined
Jan 7, 2019
Messages
482
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
@Livin404 The following is probably more what you are used to:

VBA Code:
Private Sub Air_Drop()
   Dim RowCounter As Long
   Dim StringToSearchFor    As String
'
   LastRow = Sheets("72 Hr").Range("A" & Rows.Count).End(xlUp).Row
 
    For RowCounter = 1 To LastRow
        StringToSearchFor = Mid(Sheets("72 Hr").Range("A" & RowCounter).Value, 6, 2)                 ' Get 6th and 7th character from Column A cell sheet 72 Hr
'
        If StringToSearchFor = Sheets("Air Drop").Range("A" & (RowCounter + 1)).Value Then
            If Sheets("72 Hr").Range("F" & RowCounter).Value = "" Then
                Sheets("72 Hr").Range("F" & RowCounter).Value = "CARGO ACFT"
            Else
                Sheets("72 Hr").Range("F" & RowCounter).Value = Sheets("72 Hr").Range("F" & RowCounter).Value & "/CARGO ACFT"
            End If
        End If
    Next
End Sub

This code will use a 'vlookup' style of code without an actual vlookup formula.

The data in the B column of Sheets("Air Drop") is also not necessary with this code.

BTW, The ignores are included that you asked about previously. ;)
That's great, but remeber this involves a Vlookup so the inserted text is based on what I have on the "AirDrop" worksheet. What snakehips has is what I'm looking for. I just need it to have it ignore the cells where there is no match. Thank you,
 

Snakehips

Well-known Member
Joined
May 17, 2009
Messages
5,390
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
@Livin404 Try this then.

VBA Code:
Private Sub Air_Drop()
   Dim i As Long, n As Variant
   Dim ShtAD, Sht72H, LUrng As Range
   Dim slash As String
   
   Set ShtAD = Sheets("Air Drop")
   Set Sht72H = Sheets("72 Hr")
   Set LUrng = ShtAD.Range("A1:B13")
   
   Lastr = Sht72H.Range("A" & Rows.Count).End(xlUp).row
   
    For i = 1 To Lastr
        slash = ""
         n = Mid(Sht72H.Cells(i, 1).Value, 6, 2)
       If IsNumeric(n) Then n = CLng(n)
       On Error GoTo NOMATCH
            If Not Sht72H.Cells(i, 6).Value = "" Then slash = " / "
            Sht72H.Cells(i, 6).Value = _
            Sht72H.Cells(i, 6).Value & slash & Application.WorksheetFunction.VLookup(n, LUrng, 2, 0)
NOMATCH:
        On Error GoTo 0
    Next i
End Sub
 

Forum statistics

Threads
1,147,962
Messages
5,744,060
Members
423,843
Latest member
alex2022

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top