0

So basically I have a column in my spreadsheet that tracks the status of bearing conditions. 800+ bearings spread across 8 or so sheets (different areas of a facility) and will continue to increase in the future.

There is a corresponding column that tracks the date that the status last changed.

I have several active x controls and user forms on a dashboard/homepage for the work book that allow the user to make these changes automatically, however I would like to be able to go into the sheets and manually change the status (drop down list) and have the date in corresponding cell change automatically.

I found some code I modified and it appears to work which is good

    Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Updated by Extendoffice 2017/10/12
    Dim xRg As Range, xCell As Range
    On Error Resume Next
    If (Target.Count = 1) Then
        If (Not Application.Intersect(Target, Me.Range("G5:G80")) Is Nothing) Then _
            Target.Offset(0, 1) = Date
        Application.EnableEvents = False
        Set xRg = Application.Intersect(Target.Dependents, Me.Range("G5:G80"))
        If (Not xRg Is Nothing) Then
            For Each xCell In xRg
                xCell.Offset(0, 1) = Date
            Next
        End If
        Application.EnableEvents = True
    End If
End Sub

Having got the code working as I wanted I realised I would like it to to add the date to additional cells in that row but dependent on what the cell is changed to (for example if the cell is change to "Good" also add the current date in a cell offset by 4).

I have modified the code further and it now also adding the date too cells dependent on what the change value was.

    Private Sub Worksheet_Change(ByVal Target As Excel.Range)

    Dim xRg As Range, xCell As Range
    Dim UpperIndex As Integer
    Dim LowerIndex As Integer
    Dim Rows As Integer
    
       
    Set tbl = ThisWorkbook.Worksheets("Route 1").ListObjects("Route_1_Table")
    Rows = tbl.Range.Rows.Count
    UpperIndex = 5
    LowerIndex = Rows - 3
    
    
    On Error Resume Next
    If (Target.Count = 1) Then
        If (Not Application.Intersect(Target, Me.Range("G" & UpperIndex & ":G" & LowerIndex)) Is Nothing) Then _
            Target.Offset(0, 1) = Date
            If Target.Value = "Good" Then _
            Target.Offset(0, 5) = Date
            If Target.Value = "Pending Baseline" Then _
            Target.Offset(0, 4) = Date
    End If
End Sub

As you can see I removed the last section of the code but I dont know what it did, any ideas?

braX
  • 11,506
  • 5
  • 20
  • 33
Drew Killingley
  • 13
  • 5
  • As long as I know, worksheet_change event only have one cell range. I wonder, does your `For Each r In Intersect....` work ? How is the result if you step run `Intersect(Target, Sheets("Route 1").Range("G:G"), Sheets("Route 1").Range("5:80")).select` ? Does it select one cell ? or more than one cell ? – karma Dec 30 '22 at 08:50
  • I cant actually run the code as shown above, I think Worksheet_Change stops it being runable. I tried putting the line you gave into a seperate macro and i get a runtime error 424, object required. Apologies I'm fairly new to VBA – Drew Killingley Dec 30 '22 at 08:58
  • https://stackoverflow.com/questions/35025432/auto-fill-the-date-in-a-cell-when-change-is-made-into-an-adjacent-cell this is the post I have been trying to follow – Drew Killingley Dec 30 '22 at 09:05
  • go to the code, press F9 on first execution line (line becomes dark red, is breakpoint). Now do the change and your code should stop at breakpoint.Now with F8 step through your code to understand it. – Aldert Dec 30 '22 at 09:24
  • This is just example : `Set rgCellChange = Range("A2:A10")` ---> this is the range to detect if any cell within is changed. `If Not Intersect(Target, rgCellChange) Is Nothing Then target.offset(0,1).value = format(now,"dd-mmm-yy")` --> example : a user change a value in cell A5, then cell B5 will be filled with that date. Another example : add this range : `Set rgToBeAutomaticallyChanged = Range("B2:B10")`. Change `Then target.offset(0,1).value = format(now,"dd-mmm-yy")` into `then rgToBeAutomaticallyChanged.Value = Format(Now, "dd-mmm-yy")` -> this fill B2:B10 with the date if the IF meet. – karma Dec 30 '22 at 09:29
  • Thanks for the advice guys, it has helped. Nearly got the code work as I need but just a couple more tweeks needed – Drew Killingley Dec 30 '22 at 11:18

0 Answers0