copying & paste a value based on 2 matching variables in VBA

[dsmessenger]

Hello all,

I'm hoping one of you would be kind enough to help me with some code. I'm trying to adapt some code given to me previously to match my needs

Based on the workbook i submitted the code is; Which works fine in test but not on my actual workbook.

basically i have data in my "request worksheet" in range A49:Y58
I want the code to match two bits of data first in A49:A58 second in G49:G58 - Column A49:A58 needs to lookup and match the value in the "summary worksheet" range A3:A250 and G49:G58 in row D3:Y3 also in the "summary worksheet".

if both the above match it will paste the value from the cell in column Y (the requested date) in the request sheet to the matching row and column in the summary

Sub Copy_Dates()
Dim rg As Range, R As Range, C As Range
Dim i As Long, j As Long
Dim lRow As Long, lCol As Long

Set rg = ThisWorkbook.Worksheets("Request").Cells(1, 1).CurrentRegion
Set R = ThisWorkbook.Worksheets("Summary").Cells(1, 1).CurrentRegion.Columns(1)
Set C = ThisWorkbook.Worksheets("Summary").Cells(1, 1).CurrentRegion.Rows(1)

For i = 2 To rg.Rows.Count
For j = 2 To rg.Columns.Count

If IsEmpty(rg(i, j)) = False Then
lRow = R.Find(rg(i, 1).Value).Row
lCol = C.Find(rg(1, j).Value).Column
ThisWorkbook.Worksheets("Summary").Cells(lRow, lCol).Value = rg(i, j).Value

End If

Next j
Next i


End Sub


below i started trying to specify the range but keep but it does not work and returns an error For i and For j - Clearly a complete novice and I'm sure it is something very simple.

Sub Calloff()
Dim rg As Range, R As Range, C As Range
Dim i As Long, j As Long
Dim lRow As Long, lCol As Long

Set rg = ThisWorkbook.Worksheets("Sheet3").Range("A49:K58")
Set R = ThisWorkbook.Worksheets("Sheet2").Range("D2:Y50")
Set C = ThisWorkbook.Worksheets("Sheet2").Range("A3:A250")


For i = 2 To rg.Rows.Count
For j = 2 To rg.Columns.Count

If IsEmpty(rg(i, j)) = False Then
lRow = R.Find(rg(i, 1).Value).Row
lCol = C.Find(rg(1, j).Value).Column
ThisWorkbook.Worksheets("Summary").Cells(lRow, lCol).Value = rg(i, j).Value

End If

Next j
Next i


End Sub

 

[DanteAmor]

Your explanation says some ranges but your macros have other ranges.
You can clarify with an example, using the XL2BB tool minisheet, where you have the data of the 2 sheets.

 

[DanteAmor]

I want the code to match two bits of data first in A49:A58 second in G49:G58 - Column A49:A58 needs to lookup and match the value in the "summary worksheet" range A3:A250 and G49:G58 in row D3:Y3 also in the "summary worksheet".

According to the above, the second search range is in row 3. If it is in another row, then change in this line the 3 for the row number.

Set c = sh2.Rows(3).Find(sh1.Range("G" & i).Value, , xlValues, xlWhole, , , False)

Try this:

Sub copy_dates()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim r As Range, c As Range
  Dim i As Long
  
  Set sh1 = Sheets("Request")
  Set sh2 = Sheets("Summary")
  For i = 49 To 58
    Set r = sh2.Range("A:A").Find(sh1.Range("A" & i).Value, , xlValues, xlWhole, , , False)
    If Not r Is Nothing Then
      Set c = sh2.Rows(3).Find(sh1.Range("G" & i).Value, , xlValues, xlWhole, , , False)
      If Not c Is Nothing Then sh2.Cells(r.Row, c.Column).Value = sh1.Range("Y" & i).Value
    End If
  Next
End Sub

 

[dsmessenger]

Hi all, unfortunately my work compui

Your explanation says some ranges but your macros have other ranges.
You can clarify with an example, using the XL2BB tool minisheet, where you have the data of the 2 sheets.

unfortunately my work computer doesnt allow me to install the add on, but i've include images to hopefully explain the problem.

Request sheet below

I'm trying to ask the system to look at G49 & A49 and return K49 and so on up to row 58 and then paste the date into the summary sheet

Summary sheet below

from the request sheet i would expect to see the date value from K49, K50 & K51 in D3, D4 & D5, same if i changed the text in G to "stuff 2" etc. it would place the date in column E against the correct plot number.

Hope this all makes sense.

 

[DanteAmor]

Try this:

Sub copy_dates()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim r As Range, c As Range
  Dim i As Long
  
  Set sh1 = Sheets("Request")
  Set sh2 = Sheets("Summary")
  For i = 49 To 58
    Set r = sh2.Range("A:A").Find(sh1.Range("A" & i).Value, , xlValues, xlWhole, , , False)
    If Not r Is Nothing Then
      Set c = sh2.Rows(2).Find(sh1.Range("G" & i).Value, , xlValues, xlWhole, , , False)
      If Not c Is Nothing Then sh2.Cells(r.Row, c.Column).Value = sh1.Range("K" & i).Value
    End If
  Next
End Sub

 

[dsmessenger]

thats brilliant thank you so much

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.