azwildcat
04-25-2011, 11:16 PM
I currently have an augmented 'vlookup' VBA code that I need to adjust, but I am new to creating VBA code. The code is listed below and has been modified to not only grab 1 cell of data, but the other 10 cells to the right of the cell in question(in the same row). I need this to be changed in order to find all instances for an index number(instead of grabbing the first instance of index number 2, I need this code to grab all instances of the index number 2 of which their could be 10 instances). The index number is first entered into the 'input sheet' and once the macro is executed, the information is found, copied and moved from the 'data table' to the 'input sheet'.
Please help and let me know if I can provide more information. Thanks.
The code is:
Sub LookupTest1()
'
' LookupTest1 Macro
'
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim LR1 As Long
Dim LR2 As Long
Dim LC As Long
'LC= ws1.Cells(1, Columns.Count).End(xlToLeft).Column Dim C As Range
Set ws1 = Sheets("Data Table")
Set ws2 = Sheets("Input Sheet")
LR1 = ws1.Cells(Rows.Count, "B").End(xlUp).Row
With ws1.Range("$B$2:B" & LR1)
Set C = .Find(ws2.Range("$A$3"), LookIn:=xlValues, Lookat:=xlWhole)
If Not C Is Nothing Then
fstAdd = C.Address
Do
LR2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row
ws1.Cells(C.Row, "A").Resize(1, 11).Copy ws2.Cells(LR2 + 3, "A")
Set C = .FindNext(C)
Loop While Not C Is Nothing And fstAdd <> C.Address
Else: MsgBox " Value Not Found"
End If
End With
'
End Sub
Please help and let me know if I can provide more information. Thanks.
The code is:
Sub LookupTest1()
'
' LookupTest1 Macro
'
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim LR1 As Long
Dim LR2 As Long
Dim LC As Long
'LC= ws1.Cells(1, Columns.Count).End(xlToLeft).Column Dim C As Range
Set ws1 = Sheets("Data Table")
Set ws2 = Sheets("Input Sheet")
LR1 = ws1.Cells(Rows.Count, "B").End(xlUp).Row
With ws1.Range("$B$2:B" & LR1)
Set C = .Find(ws2.Range("$A$3"), LookIn:=xlValues, Lookat:=xlWhole)
If Not C Is Nothing Then
fstAdd = C.Address
Do
LR2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row
ws1.Cells(C.Row, "A").Resize(1, 11).Copy ws2.Cells(LR2 + 3, "A")
Set C = .FindNext(C)
Loop While Not C Is Nothing And fstAdd <> C.Address
Else: MsgBox " Value Not Found"
End If
End With
'
End Sub