For Each Cell in Sheet1 Range, do some Vlookup calc. from Sheet3

[u473]

I need help in switching back & forth from sheet to sheet and using
VlookUp
& Match to retrieve values at the intersect of current Row & Column.
..
For Each Cell in Sheet1 Range, do some Vlookup calculations from
Sheet3
and write results in Sheet2 same relative range.

Assume Range in Sheet1 is B23 as follows :
Row / Col A B C D
1 Position RateA RateB RateC ....
2 Manager 10 8 12
3 Cost Engr. 6 16 6
4 .............. .. .. ..
Assume RateTable in Sheet3 is B2.. as follows :
Row / Col A B C D
1 Position RateA RateB RateC ....
2 Manager 50 55 60
3 Cost Engr. 35 40 45
4 .............. .. .. ..
For each Cell in Sheet1 range which contains Hours at specific Rate
Code,
Vlookup/Match RateTable in Sheet3 for pertaining Position,
and write Hours multiplied by Rate in Sheet2 in same relative position
as in Sheet1
as follows :
Row / Col A B C D
1 Position RateA RateB RateC ....
2 Manager 500 440 720
3 Cost Engr. 210 640 270
------ Pseudo Code ------------------------
Sub Test()
Dim rng As Range
Dim RateCat As String ' Rate Category, RateA, RateB, RateC etc...
Dim Rate As Integer : Dim LastRow as Integer
Dim Position as String
LastRow = Cells(Rows.Count,"A").End(xlUp).Row
Set rng = Range("B2" & LastRow): Range("B2").Select
For Each Cell In rng
'Vlookup/Match Position and RateCat from Sheet3 and store value in
Rate
' Multiply Sheet1.ActiveCell.Value with Rate and store result in
Sheet3,
'same relative Row/Column
ActiveCell.Offset(0, 1).Select
Next Cell
End Sub

Help appreciated,
Celeste

 

[merjet]

The solution looks easy to me, and doesn't require VBA. Merely enter
formulas on Sheet2 that use values from Sheet1 and Sheet3, e.g. for
Sheet2, cell B2: =Sheet1!B2*Sheet3!B2

Hth,
Merjet

 

[u473]

Thank you for your answer, but I want to find the solution in VBA for
further complex cases..
Celeste

 

[Joel]

Sub Test()
Dim rng As Range
Dim RateCat As String ' Rate Category, RateA, RateB, RateC etc...
Dim Rate As Integer: Dim LastRow As Integer
Dim Position As String

With Sheets("Sheet1")
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For RowCount = 2 To LastRow
Position = .Range("A" & RowCount)
With Sheets("Sheet3")
Set c = .Columns("A").Find(what:=Position, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
c.EntireRow.Copy Destination:=Sheets("Sheet2").Row(RowCount)
End If
End With
Next RowCount
End With
End Su

 

[Gary Keramidas]

give this a try and report back any issues:

Sub test()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim lastrow As Long
Dim lastcol As Long
Dim i As Long, z As Long
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Dim rngfound As Range
Set ws1 = Worksheets("Sheet1")
lastrow = ws1.Cells(Rows.Count, "A").End(xlUp).Row
lastcol = ws1.Cells(1, Columns.Count).End(xlToLeft).Column
Set ws2 = Worksheets("Sheet2")
Set ws3 = Worksheets("Sheet3")
z = 2
ws2.Activate
'Application.ScreenUpdating = False

For i = 2 To lastrow
With ws3.Columns("A:A")
Set rngfound = .Find(ws1.Range("A" & i).Value, _
lookat:=xlWhole)
If Not rngfound Is Nothing Then
ws2.Range("A" & z).Value = .Range("A" & i).Value
ws1.Range(Cells(i, "B").Address, Cells(i, _
lastcol).Address).Copy
ws2.Range("B" & z).PasteSpecial xlPasteAll
ws3.Range(Cells(rngfound.Row, "B").Address, _
Cells(rngfound.Row, lastcol).Address).Copy
ws2.Range("B" & z).PasteSpecial xlPasteAll, _
xlPasteSpecialOperationMultiply
z = z + 1
End If
End With
Next
Application.CutCopyMode = False
End Sub

 

[u473]

Thank you a thousand times. You made my day.
Those 2 examples just put me back on track of logic and syntax.
Have a good day, from Williamsburg Virginia.
Celeste