Using one VBA instead of 13.

Livin404

Livin404

Well-known Member
Joined
Jan 7, 2019
Messages
743
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

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
Sort by date Sort by votes
@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.
 
Upvote 0
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
 
Upvote 0
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,
 
Upvote 0
@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.
 
Upvote 0
Snakehips said:
@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.
Click to expand...
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.
 
Upvote 0
Snakehips said:
@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.
Click to expand...
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
 
Upvote 0
@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:
Upvote 0
johnnyL said:
@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. ;)
Click to expand...
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,
 
Upvote 0
@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
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Solved
My VBA is only copying the last row of data instead of all the rows
2 3
Replies
24
Views
512
Alex Blakenburg
A
S
  • Question
Need code that adds multiple new rows to table to include a check box in column "L" for each new row
Replies
0
Views
315
sspatriots
S
J
  • Question
Change specific values (not all) in a VBA sub
2
Replies
16
Views
443
juscuz419
J
M
  • Solved
VBA comparing cell values dosen't work consistantly
Replies
6
Views
102
michaelehoudek
M
S
  • Question
VBA to ignore certain MAC Address values but process all others
Replies
1
Views
181
myall_blues
myall_blues

Forum statistics

Threads
1,214,648
Messages
6,120,726
Members
448,987
Latest member
marion_davis

Share this page

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
Back
Top