Lookup Range - Copy and Paste to Lookup Value

[VBAMePlease]

Private Sub CommandButton3_Click()


Set lookup_rng = Range("AO22:AR20")


Application.ScreenUpdating = False


For Each Cell In lookup_rng
    If Cell.Value = Range("J20" & "J22").Value Then
        Range("J23:M24").Copy
        Cell.Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        Range("J26:M30").Copy
        Cell.Offset(3, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
    End If
    
Next Cell


Application.ScreenUpdating = True
End Sub

Any idea why this won't work and is giving me a run-time error?

 

[MrKowz]

I'm guessing it's erroring on the line:

If Cell.Value = Range("J20" & "J22").Value Then

This is because you're concatenating the range references. It is literally trying to process:

If Cell.Value = Range("J20J22").Value

Can you please describe what you are trying to accomplish with the code? I'm sure there is a much better way we can handle this, but I need to understand the intent first.

 

[VBAMePlease]

Can you please describe what you are trying to accomplish with the code? I'm sure there is a much better way we can handle this, but I need to understand the intent first.

Thank you for explanation. To provide more context:

I am storing data in AO23:BD30 based on inputs in J24:M31. In order to accurately match the data, I need to find the first Quarter in AO22:BD22 that matches my active market (J20) and paste the selection here. The copied selection from J24:M31 would then populate Quarters 2,3,4 automatically.

This is why I was having it try and match based off of J20 (Market) and J22 (Q1).

So it needs to set AO22:BD22 as the lookup range, find the value that matches "$J$20&$J$22" and then paste "J24:M31" in said cell.

 

[VBAMePlease]

Bump

 

[VBAMePlease]

Also if I could have an IF at the beginning to check J33:M33 to see if they all contain "TRUE" and if they don't it won't let you copy and paste?

Ex: Run the script and it notices J33 does not contain "TRUE", then it prompts a MsgBox and says "Allocation Incorrect".

 

[VBAMePlease]

Also if I could have an IF at the beginning to check J33:M33 to see if they all contain "TRUE" and if they don't it won't let you copy and paste?

Ex: Run the script and it notices J33 does not contain "TRUE", then it prompts a MsgBox and says "Allocation Incorrect".

@MrKowz, does this plus the description I provided earlier make sense?

 

[MrKowz]

I think I'm following, though your explanation is inconsistent with what ranges you're referring to (i.e. you say you are storing data in AO23:BD23, but you want the lookup range to be AO22:BD22, and in your original code, the lookup range was AO22:AR20.) I moved forward based on the statement "So it needs to set AO22:BD22 as the lookup range, find the value that matches "$J$20&$J$22" and then paste "J24:M31" in said cell." This also checks J33:M33 to ensure there is no cell containing FALSE. If a cell in J33:M33 contains FALSE, it returns a messagebox with "Allocation Incorrect. Refer to " (address of FALSE cell).

See if the below code accomplishes what you're looking to do.

Private Sub CommandButton3_Click()
Dim ActMarket       As String, _
    Qtr             As String
    
Dim lookup_rng      As Range, _
    rng             As Range

ActMarket = Range("J20").Value
Qtr = Range("J22").Value

Set lookup_rng = Range("AO22:BD22")

Application.ScreenUpdating = False

With Range("J33:M33")
    Set rng = .Find(False, LookIn:=xlValues, LookAt:=xlWhole)
    If Not rng Is Nothing Then
        'FALSE value found.  Return messagebox.
        MsgBox "Allocation Incorrect.  Refer to " & rng.Address
        GoTo EndSub
    End If
End With
        
With lookup_rng
    Set rng = .Find(ActMarket & Qtr, LookIn:=xlValues, LookAt:=xlWhole)
    If Not rng Is Nothing Then
        'Value found
        Range("J23:M31").Copy
        rng.PasteSpecial xlPasteValues
    End If
End With

EndSub:
Application.ScreenUpdating = True
End Sub

 

[VBAMePlease]

See if the below code accomplishes what you're looking to do.

Private Sub CommandButton3_Click()
Dim ActMarket       As String, _
    Qtr             As String
    
Dim lookup_rng      As Range, _
    rng             As Range

ActMarket = Range("J20").Value
Qtr = Range("J22").Value

Set lookup_rng = Range("AO22:BD22")

Application.ScreenUpdating = False

With Range("J33:M33")
    Set rng = .Find(False, LookIn:=xlValues, LookAt:=xlWhole)
    If Not rng Is Nothing Then
        'FALSE value found.  Return messagebox.
        MsgBox "Allocation Incorrect.  Refer to " & rng.Address
        GoTo EndSub
    End If
End With
        
With lookup_rng
    Set rng = .Find(ActMarket & Qtr, LookIn:=xlValues, LookAt:=xlWhole)
    If Not rng Is Nothing Then
        'Value found
        Range("J23:M31").Copy
        Offset(1,0)
        rng.PasteSpecial xlPasteValues
    End If
End With

EndSub:
Application.ScreenUpdating = True
End Sub

This works, my only problem is that I need the pasted range to paste 1 row below where it currently is. Would the offset included above work correctly?

 

[MrKowz]

This works, my only problem is that I need the pasted range to paste 1 row below where it currently is. Would the offset included above work correctly?

See below:

Private Sub CommandButton3_Click()
Dim ActMarket       As String, _
    Qtr             As String
    
Dim lookup_rng      As Range, _
    rng             As Range

ActMarket = Range("J20").Value
Qtr = Range("J22").Value

Set lookup_rng = Range("AO22:BD22")

Application.ScreenUpdating = False

With Range("J33:M33")
    Set rng = .Find(False, LookIn:=xlValues, LookAt:=xlWhole)
    If Not rng Is Nothing Then
        'FALSE value found.  Return messagebox.
        MsgBox "Allocation Incorrect.  Refer to " & rng.Address
        GoTo EndSub
    End If
End With
        
With lookup_rng
    Set rng = .Find(ActMarket & Qtr, LookIn:=xlValues, LookAt:=xlWhole)
    If Not rng Is Nothing Then
        'Value found
        Range("J23:M31").Copy
        rng.Offset(1, 0).PasteSpecial xlPasteValues
    End If
End With

EndSub:
Application.ScreenUpdating = True
End Sub

 

[VBAMePlease]

@MrKowz, working like a charm. Many thanks.