HELP WITH EDIT VBA CODE

[Jagat Pavasia]

Hi,

I have VBA code :

Private Sub worksheet_change(ByVal Target As Range)

Dim rng As Range
 
  If Target.Count > 1 Then Exit Sub
  Application.EnableEvents = False
  ActiveSheet.Unprotect
  Set rng = Range("C:C")
  If Not Intersect(Target, rng) Is Nothing Then
    If Target.Value = "**" Then Target.Value = Format(Date, "mm/dd/yyyy")
  End If

  If Not Intersect(Target, Range("A4:K4")) Is Nothing Then
      If Target.Value = "" Then
          ActiveSheet.Range("A6:K6").AutoFilter Field:=Target.Column
      Else
          ActiveSheet.Range("A6:K6").AutoFilter Field:=Target.Column, Operator:=xlFilterValues, Criteria1:=CStr(Target.Value)
      End If
  End If
  ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFiltering:=True
  Application.EnableEvents = True
End Sub

I want to edit this VBA code that if I type "**" in C:C then it should be auto type "NIGHT",
and if I type "**" in D:D then it should be auto type "DAY"


please give me VBA with edited

 

[BrianM45]

Hi Jagat Pavasia

Maybe like this

Private Sub worksheet_change(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  Application.EnableEvents = False
  ActiveSheet.Unprotect
  
  If Not Intersect(Range("C:C"), Target) Is Nothing _
    And Target.Value = "**" Then
      Target.Value = "NIGHT"
      GoTo EndSub
  End If
  If Not Intersect(Range("D:D"), Target) Is Nothing _
    And Target.Value = "**" Then
      Target.Value = "DAY"
      GoTo EndSub
  End If
  ' Else
  If Not Intersect(Target, Range("A4:K4")) Is Nothing Then
      If Target.Value = "" Then
          ActiveSheet.Range("A6:K6").AutoFilter Field:=Target.Column
      Else
          ActiveSheet.Range("A6:K6").AutoFilter Field:=Target.Column, Operator:=xlFilterValues, Criteria1:=CStr(Target.Value)
      End If
  End If
  
EndSub:
  ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFiltering:=True
  Application.EnableEvents = True
End Sub

A+

 

[Jagat Pavasia]

Hi Jagat Pavasia

Maybe like this

Private Sub worksheet_change(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  Application.EnableEvents = False
  ActiveSheet.Unprotect
 
  If Not Intersect(Range("C:C"), Target) Is Nothing _
    And Target.Value = "**" Then
      Target.Value = "NIGHT"
      GoTo EndSub
  End If
  If Not Intersect(Range("D:D"), Target) Is Nothing _
    And Target.Value = "**" Then
      Target.Value = "DAY"
      GoTo EndSub
  End If
  ' Else
  If Not Intersect(Target, Range("A4:K4")) Is Nothing Then
      If Target.Value = "" Then
          ActiveSheet.Range("A6:K6").AutoFilter Field:=Target.Column
      Else
          ActiveSheet.Range("A6:K6").AutoFilter Field:=Target.Column, Operator:=xlFilterValues, Criteria1:=CStr(Target.Value)
      End If
  End If
 
EndSub:
  ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFiltering:=True
  Application.EnableEvents = True
End Sub

A+

thank you so much.......

BrianM45​