CODEWITHSUNDEEP
vbaexcel
CamlCase
CamlCase

Reputation: 191

Combining 2 "Private Sub Worksheet_Change(ByVal Target As Range)" into 1

I am creating an Excel spreadsheet. I have 2 separate functions that I need to combine but I am not sure how to smash them together. I know I can only have 1 change event. The first function will unprotect the sheet (column c is locked), auto populate column C when data is entered in to column A or erase C when A is erased and re-protect when complete. The second will return the cell focus to the next row, column A, when data is entered into A and B. Separately they work as needed. 

    Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Unprotect Password:="my password"
    If Target.Column = 1 Then
        Dim A As Range, B As Range, Inte As Range, r As Range
       Set A = Range("A:A")
       Set Inte = Intersect(A, Target)
    If Target.Offset(0, 1 - Target.Column).Value = "" Then
        Target.Offset(0, 3 - Target.Column).Clear
        Exit Sub
    End If
    Application.EnableEvents = False
    For Each r In Inte
    r.Offset(0, 2).Value = Date & " " & Time
    r.Offset(0, 2).NumberFormat = "m/d/yyyy h:mm am/pm"
    Next r
    Application.EnableEvents = True       
    End If
    Protect Password:="my password"
    End Sub


    Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Whoa
    Application.EnableEvents = False
    If Not Target.Cells.CountLarge > 1 Then
    If Not Intersect(Target, Columns(1)) Is Nothing Then
        Target.Offset(, 1).Select
    ElseIf Not Intersect(Target, Columns(2)) Is Nothing Then
        Target.Offset(1, -1).Select
    End If
    End If
    Letscontinue:
    Application.EnableEvents = True
    Exit Sub
    Whoa:
    MsgBox Err.Description
    Resume Letscontinue
    End Sub

Upvotes: 0

Views: 904

Answers (2)

Reen de Winter
Reen de Winter

Reputation: 79

Implement it in two Sub-Procedures on a modul, then just call both of them in the Event-Procedure.

Upvotes: 1

Chumble
Chumble

Reputation: 89

How about this, seems to do what you want, as I understand the question.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rngIntersect    As Range
    Dim rngCell         As Range

    On Error GoTo TidyUp

    Application.EnableEvents = False

    If Target.Column = 1 Then

        Set rngIntersect = Intersect(Range("A:A"), Target)

        For Each rngCell In rngIntersect
            If rngCell.Value = "" Then
                rngCell.Offset(0, 2).Value = ""
            Else
                rngCell.Offset(0, 2).Value = Date & " " & Time
                rngCell.Offset(0, 2).NumberFormat = "m/d/yyyy h:mm am/pm"
            End If
        Next rngCell
    End If

    If Target.Column < 3 And Target.Value <> "" Then  ' lose the 'And Target.Value <> ""' as desired
        Cells(Target.Row + Target.Rows.Count, 1).Select
    End If

TidyUp:

    Set rngIntersect = Nothing
    Set rngCell = Nothing

    Application.EnableEvents = True

End Sub

I'd also suggest using UserInterfaceOnly in your worksheet.Protect, then you don't have to unprotect the sheet for VBA to act on the sheet.

Upvotes: 1

Related Questions