简体   繁体   中英

How Does One Combine two Private Sub Worksheet_Change(ByVal Target As Range) in One Work Sheet?

Disclaimer: I'm very new to VBA, so obvious things probably fly over my head.

I'm trying to set up 2 columns that automatically update with that day's date when the column next to it receives new data in that sheet only.

I tried, with my limited knowledge, to create new variables, so that it has 2 'lines' to go with, if that makes sense, but it just stops working altogether.

Is there any way I can 'duplicate' the below code so that column O updates with today's date when column P is updated, and the same for column E when D is changed? If possible, it would be nice if column E didn't update when the text in D is "N/A"

Any help or pointers are appreciated.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim WorkRng As Range
    Dim Rng As Range
    Dim xOffsetColumn As Integer
    Set WorkRng = Intersect(Application.ActiveSheet.Range("P:P"), Target)
    xOffsetColumn = 1
    If Not WorkRng Is Nothing Then
        Application.EnableEvents = False
        For Each Rng In WorkRng
            If Not VBA.IsEmpty(Rng.Value) Then
                Rng.Offset(0, xOffsetColumn).Value = Now
            Else
                Rng.Offset(0, xOffsetColumn).ClearContents
            End If
        Next
        Application.EnableEvents = True
    End If
End Sub

You will need to put checks in place so that you only have 1 worksheet_change , but allowing separate actions depending on the target range. Try something like:

Select Case Target.Column
    Case 15
        'that stuffs
    Case 16
        'that other stuffs
End Select

edtit1 yes, @GSerg, that is true... updated

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False

    UpdateNextColumnIfNeeded Application.Intersect(Me.Range("P:P"), Target)
    UpdateNextColumnIfNeeded Application.Intersect(Me.Range("D:D"), Target)

    Application.EnableEvents = True
End Sub


Private Sub UpdateNextColumnIfNeeded(ByVal WorkRng As Range)
  If WorkRng Is Nothing Then Exit Sub

  Dim Rng As Range

  For Each Rng In WorkRng.Cells
      If IsEmpty(Rng.Value) Then
          Rng.Offset(0, 1).ClearContents
      Else
          Rng.Offset(0, 1).Value = Now
      End If
  Next
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM