Solved

VBA Excel

Posted on 2013-11-19
4
268 Views
Last Modified: 2013-11-20
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
Comment
Question by:tesla764
  • 2
4 Comments
 
LVL 33

Expert Comment

by:Norie
Comment Utility
Remove this, it stops all code execution.
End

Open in new window

0
 
LVL 6

Expert Comment

by:Michael
Comment Utility
Nevermind my question, I misread...
0
 
LVL 6

Accepted Solution

by:
Michael earned 500 total points
Comment Utility
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
 

Author Closing Comment

by:tesla764
Comment Utility
Thanks everything is looking good.
0

Featured Post

What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Suggested Solutions

Title # Comments Views Activity
Using MS Code on my Mac 6 42
crm development 2 34
Hovering effect 9 27
Javascript Refresh Parent Page from Popup 3 21
For most people, the WrapPanel seems like a magic when they switch from WinForms to WPF. Most of us will think that the code that is used to write a control like that would be difficult. However, most of the work is done by the WPF engine, and the W…
Entering time in Microsoft Access can be difficult. An input mask often bothers users more than helping them and won't catch all typing errors. This article shows how to create a textbox for 24-hour time input with full validation politely catching …
This is Part 3 in a 3-part series on Experts Exchange to discuss error handling in VBA code written for Excel. Part 1 of this series discussed basic error handling code using VBA. http://www.experts-exchange.com/videos/1478/Excel-Error-Handlin…
This video explains how to create simple products associated to Magento configurable product and offers fast way of their generation with Store Manager for Magento tool.

728 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

14 Experts available now in Live!

Get 1:1 Help Now