Need to compare 2 cell values and change 3rd cell if different

[arcaidius]

Good Afternoon,

I have a code to change cell in Column B when A is changed. I would like to also compare this new value in column B to the cell above it, and if different put todays date in column G.
Any Ideas? Here is my code: Have it on Worksheet - Change

Private Sub Worksheet_Change(ByVal Target As Range)


Dim aCellColumn As Integer
Dim aTimeColumn As Integer
Dim aRow, aCol As Integer
Dim aDPRg, aRg As Range
aCellColumn = 1
aTimeColumn = 2
aRow = Target.Row
aCol = Target.Column
If Target.Text <> "" Then
    If aCol = aCellColumn Then
       Cells(aRow, aTimeColumn) = Sheets("Main").Range("D2").Value
    Else
        On Error Resume Next
        Set aDPRg = Target.Dependents
        For Each aRg In aDPRg
            If aRg.Column = aCellColumn Then
                Cells(aRg.Row, aTimeColumn) = Sheets("Main").Range("D2").Value
            End If
        Next
    End If
End If
End Sub

 

[arcaidius]

Well I thought I almost Had it. I got it to update the right cell but it does it whether or not the values are the same.
To explain a little bit, I am entering the month and year as text in column A for my chart labels. Then my code uses the changed cell function to paste a goal amount in Column B from another sheet. What I want to add to this code is if the last entry in column B is different than the previous entry in Column B to put the date in Column G.

I tried to improvise the code above but it is putting the date in column G every time even if the two values are the same. Also it throws up an error 91: Object variable or With block variable not set and highlights this section of code:

If Cells(aRg.Row, aTimeColumn).Value <> Cells(aRg.Row, aTimeColumn).Offset(-1, 0).Value Then

So here is the whole code below, i added a note where I'm getting the error, could someone please help?

Private Sub Worksheet_Change(ByVal Target As Range)

Dim aCellColumn As Integer
Dim aTimeColumn As Integer
Dim aRow, aCol As Integer
Dim aDPRg, aRg As Range
aCellColumn = 1
aTimeColumn = 2
gTimeColumn = 7
aRow = Target.Row
aCol = Target.Column
If Target.Text <> "" Then
    If aCol = aCellColumn Then
       Cells(aRow, aTimeColumn) = Sheets("Main").Range("D2").Value
    Else
        On Error Resume Next
        Set aDPRg = Target.Dependents
        For Each aRg In aDPRg
            If aRg.Column = aCellColumn Then
                Cells(aRg.Row, aTimeColumn) = Sheets("Main").Range("D2").Value
            End If
        Next
    End If
End If

'Error occurs here
If Cells(aRg.Row, aTimeColumn).Value <> Cells(aRg.Row, aTimeColumn).Offset(-1, 0).Value Then

Cells(aRow, gTimeColumn) = Now()
        On Error Resume Next
        Set aDPRg = Target.Dependents
        For Each aRg In aDPRg
            If aRg.Column = aCellColumn Then
                Cells(aRg.Row, gTimeColumn) = Now()
            End If
Next
End If

End Sub

 

[GWteB]

The line of code on which VBA errors out is outside the For Each aRg In aDPRg loop, so aRg has no reference to any worksheet range at all.
Not quite sure what you want to achieve but I would like to take a look.

 

[arcaidius]

Not sure how to attach the work book so here you go:
On this sheet we are entering data each month . The "Date Active" column is when the goal was changed. I made a "Main" Sheet where we can change all the goals for each metric. Trying to Automate as much as possible to save time, its a long arduous process.

So the first Code I posted works fine, when for example Dec 2020 is entered into the next row of column A, The number 3 is pulled from the Main Sheet and put in Column B. What i want to add to the code is that if the goal changes say to 2.5 or whatever, to put a date in the date active column, if its the same do nothing.

Frequency

Goal Max TRIR

TRIR Actual

Goal Max LTIR

LTIR Actual

Goal Met?

Date Active

Date Measured

Sep 2020	3	0.91	1	0	Yes	08/01/2019	9/30/2020
Oct 2020	3	0.95	1	0	Yes	08/01/2019	10/31/2020
Nov 2020	3	4.00	1	2	Yes		11/30/2020

 

[GWteB]

I suspect you are looking for something like this ...

Private Sub Worksheet_Change(ByVal Target As Range)
   
   If Not Application.Intersect(Target, Columns("A")) Is Nothing Then
        
        With Target
            If .Count = 1 And Len(.Text) > 0 Then
                .Offset(0, 1) = Sheets("Main").Range("D2").Value
                If .Offset(0, 1).Value <> .Offset(-1, 0).Value Then
                    Application.EnableEvents = False
                    .Offset(0, 6).Value = Date
                    Application.EnableEvents = True
                End If
            End If
        End With
    End If
End Sub

 

[GWteB]

Apologies, made a typo
The second zero in this line should be a 1

If .Offset(0, 1).Value <> .Offset(-1, 1).Value Then

 

[arcaidius]

Thank you Sir, You are a GENIUS!

 

[GWteB]

You are welcome and glad you like it.