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
 

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
1,846
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
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,
The code I provided uses the the Column A from the airdrop sheet.
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.

Livin404

Active Member
Joined
Jan 7, 2019
Messages
482
Office Version
  1. 365
  2. 2019
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
Thank you, I'm afraid it's doing the same thing as shown in the image. I was so sure it would work. I know we're getting there for sure. You've been great. Thank you, :e
 

Snakehips

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

VBA Code:
Private Sub Air_Drop()
   Dim i As Long, n As Variant
   Dim ShtAD, Sht72H, LUrng As Range
   Dim slash, GotIt 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 = ""
        GotIt = ""
         n = Mid(Sht72H.Cells(i, 1).Value, 6, 2)
       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
 
Solution

Livin404

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

VBA Code:
Private Sub Air_Drop()
   Dim i As Long, n As Variant
   Dim ShtAD, Sht72H, LUrng As Range
   Dim slash, GotIt 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 = ""
        GotIt = ""
         n = Mid(Sht72H.Cells(i, 1).Value, 6, 2)
       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
Bloody Outstanding. It is spot on. At least for now. Thank you so much for your leadership in this. I'm over the moon.
 

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
1,846
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows

ADVERTISEMENT

Apologies to @Livin404, I assumed you wanted similar format to your previous thread.

I did not see that you wanted to do away with that style of appending to what was in a column and use a different column

With that in mind my code suggestion should have been:

VBA Code:
Private Sub Air_DropV3()
   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 = Sheets("Air Drop").Range("B" & (RowCounter + 1)).Value
            Else
                Sheets("72 Hr").Range("F" & RowCounter).Value = Sheets("Air Drop").Range("B" & (RowCounter + 1)).Value & "/" & Sheets("Air Drop").Range("B" & (RowCounter + 1)).Value
            End If
        End If
    Next
End Sub
 

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
1,846
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
Crap that is not right either:

VBA Code:
Private Sub Air_DropV3()
   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 = Sheets("Air Drop").Range("B" & (RowCounter + 1)).Value
            Else
                Sheets("72 Hr").Range("F" & RowCounter).Value = Sheets("72 Hr").Range("F" & RowCounter).Value & "/" & Sheets("Air Drop").Range("B" & (RowCounter + 1)).Value
            End If
        End If
    Next
End Sub

That should do it.
 

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
1,846
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows

ADVERTISEMENT

Try this.

VBA Code:
Private Sub Air_Drop()

       Dim i As Long, n As Variant

       Dim ShtAD, Sht72H, LUrng As Range

       Dim slash, GotIt As String

     End Sub
 
Last edited:

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
1,846
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
Try this.

VBA Code:
Private Sub Air_Drop()
   Dim i As Long, n As Variant
   Dim [B]ShtAD[/B], [B]Sht72H[/B], LUrng As Range
   Dim [B]slash[/B], GotIt As String

@Snakehips I hope you realize that you can't dim variables like that and expect them to be declared as I am assuming that you think they are being declared.

The way you have it now =:

VBA Code:
Dim ShtAD As Variant
Dim Sht72H As Variant
Dim slash As Variant
;)
 
Last edited:

johnnyL

Well-known Member
Joined
Nov 7, 2011
Messages
1,846
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
And finally with a loop to make my code work properly:

VBA Code:
Private Sub Air_DropV4()
'
    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
        StringToSearchFor = Mid(Sheets("72 Hr").Range("A" & RowCounter72Hr).Value, 6, 2)        ' Get 6th and 7th character from Column A cell sheet 72 Hr
'
        For RowCounterAirDrop = 2 To LastRowAirDrop
            If StringToSearchFor = Sheets("Air Drop").Range("A" & RowCounterAirDrop).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
                Else
                    Sheets("72 Hr").Range("F" & RowCounter72Hr).Value = Sheets("72 Hr").Range("F" & RowCounter72Hr).Value & "/" & Sheets("Air Drop").Range("B" & RowCounterAirDrop).Value
                End If
            End If
        Next
    Next
End Sub
 

Forum statistics

Threads
1,147,958
Messages
5,744,043
Members
423,841
Latest member
barren

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