VBA Macro for Copy Pasting Values Based on Row Number Lookup

[marjieboone77]

Hi there - I'm working on a macro for copying and pasting a row of data based on a lookup of the selected row by reference in a different worksheet. Specifically, I want the rows that have formulas but no values to remain as formulas; however, this setup is only converting row 3 to values no matter what the lookup reference value is (due to the Range (B3:B3) reference. Help!!!

Sub Worksheet_Calculate()
Dim A As Range, r As Range, B As Range, s As Range
Set A = Range("B3:3")
Set B = Range("A:A")
For Each s In B
If s.Value = Worksheets("Air Emissions Grid").Range("N3") Then
For Each r In A
If r.HasFormula And r > 0 Then
r.Value = r.Value
End If
Next r
End If
Next s
End Sub

Thanks,
Marjie

 

[JLGWhiz]

Hi Marjie, welcome to the forum. Your code needed some work. The title was not correct for an event macro. To prevent a perpetual loop, I added the 'Application.EnableEvents' statements at the beginning and end of you procedure. This turns off the event trigger which would be constantly firing as your macro ran because of the formulas in the worksheet. It then turns it back on after the changes are completed by the macro. I also added a variable for the last row (lr) so the range in you A variable will have a limit of only where you have data. And finally, I modified your cridteria to determine if column B has a value > zero or blank. To use this macro, right click the sheet name tab where you want it to process. Select 'View Code in the pop up menu and copy and paste this procedure into the large code pane that displays. Be sure you are not in design mode then close the VB editor window and save the workbook as a macro enabled workbook if not already done.

Private Sub Worksheet_Calculate()
 Dim A As Range, r As Range, B As Range, s As Range, lr As Long
 lr = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
 Application.EnableEvents = False
 Set A = Range("B3:B" & lr)
 Set B = Range("A:A")
 For Each s In B
    If s.Value = Worksheets("Air Emissions Grid").Range("N3") Then
        For Each r In A
            If r.HasFormula And r.Value > 0 And r.Value > "" Then
                r.Value = r.Value
            End If
        Next r
    End If
 Next s
 Application.EnableEvents = True
 End Sub

The code should run when you make a change that initiates calculation.

 

[marjieboone77]

Thank you so much, JLGWhiz! Worked like a charm. Much appreciated!!!

 

[JLGWhiz]

Thank you so much, JLGWhiz! Worked like a charm. Much appreciated!!!

You're welcome,
regards, JLG