[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 281
  • Last Modified:

VBA Excel

Could someone please give us some help with this code...

1) Read DRA Summary sheet and find GQ-000

2) Find GQ-000 in the Data sheet

3) Get the value in the 5th column(Data sheet) and move it to the cell that is above the cell where GQ-000 was found in the DRA Summary sheet.

4) Repeat until all occurrences of GQ-* have been found.
I attached the workbook also.

Code so far...

Sub Get_GQnumber1()

    Dim rng As Range, cell As Range
    Dim lc As Long, ResultCol As Long
    Dim s As String, sInput As String

    lc = Cells(3, Columns.Count).End(xlToLeft).Column

         ResultCol = 5

    Set rng = Range(Cells(3, 1), Cells(3, lc))

    'Set lookup range

    Set LkupRng = Sheets("Data").Range("A1").CurrentRegion

    For Each cell In rng
        If cell.Value Like "GQ-*" Then
            'MsgBox cell.Value
            s = Left(cell.Value, InStr(1, cell.Value & " ", " ") - 1)
            'MsgBox "s: " & s

            On Error Resume Next
            v = Application.VLookup(s, Worksheets("Data").Range("lc"), 5, 0)
                     
            x = Application.VLookup(s, Worksheets("Data").Range("A:E"), 5, 0)

           Sheets("DRA Summary").Range("F2") = v

            End
      End If

    Next

End Sub
Data.xlsm
0
tesla764
Asked:
tesla764
  • 2
1 Solution
 
NorieCommented:
Remove this, it stops all code execution.
End

Open in new window

0
 
MichaelBusiness AnalystCommented:
Nevermind my question, I misread...
0
 
MichaelBusiness AnalystCommented:
Try this:

Sub Get_GQnumber1()

    Dim rng As Range, cell As Range
    Dim lc As Long, ResultCol As Long
    Dim s As String, sInput As String

    lc = Cells(3, Columns.Count).End(xlToLeft).Column

    ResultCol = 5

    Set rng = Range(Cells(3, 1), Cells(3, lc))

    'Set lookup range
    Set LkupRng = Sheets("Data").Range("A1").CurrentRegion

    For Each cell In rng
        If cell.Value Like "GQ-*" Then
            'MsgBox cell.Value
            s = Left(cell.Value, InStr(1, cell.Value & " ", " ") - 1)
            'MsgBox "s: " & s

            On Error Resume Next
            v = Application.VLookup(s, LkupRng, ResultCol, 0)
            
            cell.Offset(-1).Value = v
        End If

    Next

End Sub

Open in new window

0
 
tesla764Author Commented:
Thanks everything is looking good.
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now