Help with VBA

[terrib54]

I have the following code that works but it replaces the entire line. I need multiple ranges. I tried but when I posed something in column it overwrote all the other cell dates. I need each to be stamped individually so I missed something.

I apologize ahead of time. I'm new - trying hard but not having any luck. Can anyone tell me how to have each range only post the date/time in the column just to the left of it. IE: J5:36 posts to I5:I36, L5:L36 posts to K5:36.

This is a 12 month spreadsheet and once a month a post if made via formula that needs to post the time data is posted. Since a formula pulls the data from other sheets I need the Worksheet_Calculate function.

Thanks in advance.

Private Sub Worksheet_Calculate()
Dim rng As Range, cl As Range
Static OldData As Variant
Application.EnableEvents = False
Set rng = Me.Range("J5:J36,L5:L36,N5:N36,P5:P36,R5:R36,T5:T36,V5:V36,X5:X36,Z5:Z36,ab5:ab36,AD5:AD36")
If IsEmpty(OldData) Then
OldData = rng.Value
End If
For Each cl In rng.Cells
If Len(cl) = 0 Then
cl.Offset(0, -1).ClearContents
Else
If cl.Value <> OldData(cl.Row - rng.Row + 1, 1) Then
With cl.Offset(0, -1)
.NumberFormat = "m/d/yy h:mm:ss"
.Value = Now
End With
End If
End If
Next
OldData = rng.Value
Application.EnableEvents = True
End Sub

 

[shg]

Are those cells being changed manually by the user, or do they contain formulas?

 

[terrib54]

Are those cells being changed manually by the user, or do they contain formulas?

The Summary sheet is based on formulas from the department sheets. No manual entries on that worksheet. For instance, cell J5=HR!F4. All data on the summary sheet is based on formulas which is why I need the WS-Calculate I believe.

Summary Sheet (holds all data and dates)
HR
Operations
Supply Chain
Finance
Engineering
Quality

 

[shg]

OldData = rng.Value

... only reads in the first area of a multi-area range.

Maybe like this, but completely untested:

Private Sub Worksheet_Calculate()
  Static avOld      As Variant
  Static avNew      As Variant
  Dim iRow          As Long
  Dim iCol          As Long

  On Error GoTo Oops
  Application.EnableEvents = False
  
  With Range("J5:AD36")
    If IsEmpty(avOld) Then
      avOld = .Value2

    Else
      avNew = .Value2

      For iCol = 1 To UBound(avOld, 2) Step 2
        For iRow = 1 To UBound(avOld, 1)
          If IsEmpty(avNew(iRow, iCol)) Then
            Cells(iRow + .Row - 1, .iCol + .Column - 2).ClearContents
          ElseIf avNew(iRow, iCol) <> avOld(iRow, iCol) Then
            Cells(iRow + .Row - 1, .iCol + .Column - 2) = Now()
          End If
        Next iRow
      Next iCol
      avOld = avNew
    End If
  End With

Oops:
  Application.EnableEvents = True
End Sub

 

[terrib54]

OldData = rng.Value

... only reads in the first area of a multi-area range.

Maybe like this, but completely untested:

Private Sub Worksheet_Calculate()
  Static avOld      As Variant
  Static avNew      As Variant
  Dim iRow          As Long
  Dim iCol          As Long

  On Error GoTo Oops
  Application.EnableEvents = False
  
  With Range("J5:AD36")
    If IsEmpty(avOld) Then
      avOld = .Value2

    Else
      avNew = .Value2

      For iCol = 1 To UBound(avOld, 2) Step 2
        For iRow = 1 To UBound(avOld, 1)
          If IsEmpty(avNew(iRow, iCol)) Then
            Cells(iRow + .Row - 1, .iCol + .Column - 2).ClearContents
          ElseIf avNew(iRow, iCol) <> avOld(iRow, iCol) Then
            Cells(iRow + .Row - 1, .iCol + .Column - 2) = Now()
          End If
        Next iRow
      Next iCol
      avOld = avNew
    End If
  End With

Oops:
  Application.EnableEvents = True
End Sub

I need the code to date the column just to the left of the newly updated field. I don't see that here. Where would I add that back not to throw and error?

 

[shg]

Cells(iRow + .Row [COLOR="#FF0000"]- 1[/COLOR], .iCol + .Column [COLOR="#FF0000"]- 2[/COLOR])...

But again, untested.

 

[terrib54]

WS_Calculate and WS_Change work together great, but I am hoping to not go back each month to change the column letters to the next set. I am looking for a way to include L, N, P, R, T, V, X, Z, AB, AD.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    With Target
        If .Count > 1 Then Exit Sub
        If Not Intersect(Range("[B][COLOR=#0000CD]J8:J36[/COLOR][/B]"), .Cells) Is Nothing Then
            Application.EnableEvents = False
            If IsEmpty(.Value) Then
                .Offset(0, -1).ClearContents
            Else
                With .Offset(0, -1)
                    .NumberFormat = "m/d/yy h:mm"
                    .Value = Now
                End With
            End If
            Application.EnableEvents = True
        End If
    End With
End Sub

Private Sub Worksheet_Calculate()
    Dim rng As Range, cl As Range
    Static OldData As Variant
    Application.EnableEvents = False
    Set rng = Me.Range("[B][COLOR=#0000CD]J8:J36[/COLOR][/B]")
    If IsEmpty(OldData) Then
        OldData = rng.Value
    End If
    For Each cl In rng.Cells
        If Len(cl) = 0 Then
            cl.Offset(0, -1).ClearContents
        Else
            If cl.Value <> OldData(cl.Row - rng.Row + 1, 1) Then
                With cl.Offset(0, -1)
                    .NumberFormat = "m/d/yy h:mm:ss"
                    .Value = Now
                End With
            End If
        End If
    Next
    OldData = rng.Value
    Application.EnableEvents = True
End Sub

 

[shg]

Have we changed topic? My code tests all of those columns.

 

[terrib54]

No I missed the last post. Sorry.

So I need to insert

Cells(iRow + .Row [COLOR=#ff0000]- 1[/COLOR], .iCol + .Column [COLOR=#ff0000]- 2[/COLOR])...

right after

If Not Intersect(Range("[B][COLOR=#0000cd]J8:J36[/COLOR][/B]"), .Cells) Is Nothing Then

 

[shg]

Why not try the code I posted, as is?