How to monitor cells in a column for changes, to execute macro on a row?

[wiseone]

Hello,

I would like cells in a specific column to be monitored for changes, then execute a macro on the row which has changed.

I found the below code from an older post, and it works, however when I enter data and click "enter" the selection goes to the next row and executes my macro on the wrong row. If I click "tab" instead of "enter", it works as expected.

I also have a button which executes my macro, so I would like it to work both ways.

Any suggestions on how to make this work in all circumstances, that being:

1. Hitting Enter
2. HItting Tab
3. Clicking Macro button

Paste this code in "ThisWorksheet":

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Index = 1 Then     ' 1'st sheet in workbook
    If Target.Column = 3 Or Target.Column = 4 Then  ' 3'rd and 4th colums are active
    Application.Run ("MyMacro") 'Change 'MyMacro to your Macro's name
    End If
End If
If Sh.Index = 2 Then     ' 2'st sheet in workbook
    If Target.Column = 3 Or Target.Column = 4 Then  ' 3'rd and 4th colums are active
    Application.Run ("MyMacro") 'Change 'MyMacro to your Macro's name
    End If
End If
End Sub

 

[mumps]

Please post the code in "MyMacro".

 

[wiseone]

'This Sub used to import exchange rate from the date invoice paid into early pay discount column.

'*****************************************************************************************
'*                                                                                       *
'*      IMPORTANT - THIS MACRO EXECUTES FROM A MONITORING MACRO ON "THIS WORKSHEET"      *
'*                                                                                       *
'*****************************************************************************************

Sub Import_EarlyPay_Exchange_Rate()

Dim DatesToCheckARR() As String
Dim RangeSize As Integer
Dim i As Integer
Dim Active_Row As Integer
Dim Paid_Date As String
Dim ExchangeRateCell As String
Dim Answer As Integer
Dim CurrencyCell As String

'Set Size of the Array Variable to the number of rows in the Exhange rates range.  Range name is auto made when importing the table using the "Data > get external data > from Web " built in Excel function on the ribbon.
RangeSize = Sheets("Exchange Rates").Range("_?series_5B_5D_FXUSDCAD_lookupPage_lookup_daily_exchange_rates_2017.php_startRange_2011_09_23_rangeType_range_rangeValue_1.m_dFrom__dTo__submit_button_Submit").Rows.Count
ReDim Preserve DatesToCheckARR(RangeSize, 2)

'Import data into an Array
For i = LBound(DatesToCheckARR) + 1 To UBound(DatesToCheckARR) - 1
 
    DatesToCheckARR(i, 1) = Sheets("Exchange Rates").Cells(5 + i, 1).Value 'Cells (Rows, Columns), Dates
    DatesToCheckARR(i, 2) = Sheets("Exchange Rates").Cells(5 + i, 2).Value 'Cells (Rows, Columns), Exchange Rates USD to CAD
    'Debug.Print "Dates to Check #" & i & " = " & DatesToCheckARR(i, 1) & ", Rate: " & DatesToCheckARR(i, 2)
Next

Active_Row = Selection.Row
Paid_Date = Cells(Active_Row, Range("EarlyPay_Date").Column).Value
ExchangeRateCell = Cells(Active_Row, Range("EarlyPay_Exch").Column).Value
CurrencyCell = Cells(Active_Row, Range("Currency").Column).Value
'Debug.Print "Ship Date Row selected = " & Ship_Date

If Paid_Date = "" Then
    MsgBox "Early Pay - Date Paid Cell is Empty.", vbExclamation, "CAUTION!"
    GoTo Finish
End If


If ExchangeRateCell <> "" Then
    Answer = MsgBox("OVERWRITE EXSITING EXCHANGE RATE? This Cannot be undone!!!" & vbNewLine & vbNewLine & vbNewLine & _
                " ", vbQuestion + vbYesNo + vbDefaultButton2, "CAUTION!")
       
    If Answer = vbNo Then
        GoTo Finish
    End If
End If

Application.ScreenUpdating = False

If CurrencyCell = "CAD" Then
   
    Cells(Active_Row, Range("EarlyPay_Exch").Column).Value = 1 'did this per karen's request.
    GoTo Finish

Else
    'Copy Data from the Array into the selected cell.
    For i = LBound(DatesToCheckARR) + 1 To UBound(DatesToCheckARR) - 1
        If Paid_Date = DatesToCheckARR(i, 1) Then
           
            'Check if there is a Bank Holiday and choose the date before if there is.
            If DatesToCheckARR(i, 2) = "Bank holiday" Then
                Cells(Active_Row, Range("EarlyPay_Exch").Column).Value = DatesToCheckARR(i - 1, 2)
            Else
                Cells(Active_Row, Range("EarlyPay_Exch").Column).Value = DatesToCheckARR(i, 2)
            End If
           
            GoTo Finish 'This happens once the correct date is found.
       
        End If
    Next
   
End If

'This message should only appear if the for loop completes indicating that the match was not found.
MsgBox "Exchange Rate not Found on Exchange Rate Tab.", vbExclamation, "CAUTION!!!"

Finish:
    Application.ScreenUpdating = True

End Sub

 

[mumps]

I think that you could replace your current Workbook_SheetChange event with the following:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Sh.Index = 1 Or Sh.Index = 2 Then
        If Target.CountLarge > 1 Then Exit Sub
        If Intersect(Target, Range("C:D")) Is Nothing Then Exit Sub
        Application.Run ("MyMacro")
    End If
End Sub

when I enter data and click "enter" the selection goes to the next row

In the Import_EarlyPay_Exchange_Rate macro, you use the variable Active_Row which will refer to whichever row is currently selected. When you press ENTER, a cell in the row below will be selected so the variable refers to that row. There may be other variables that have the same effect. If you replace this line of code:

Application.Run ("MyMacro")

with the actual code that line is calling, instead of Active_Row you could use Target.Row which will always refer to the row that triggers the macro.

 

[wiseone]

Thx, Will Target.Row work if the macro is triggered other than with Workbook_sheetChange?

 

[mumps]

No it won’t.