VBA code is not working

Jagat Pavasia

Active Member
Joined
Mar 9, 2015
Messages
406
Office Version
  1. 2021
Platform
  1. Windows
1.JPG


VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
Application.EnableEvents = False
Me.Unprotect
If Not Intersect(Target, [B:B,L:L]) Is Nothing Then
    If Target.Value = "**" Then
        Target.Value = Date
        Target.NumberFormat = "DD/MM/YYYY"
    End If
ElseIf Not Intersect(Target, [E1]) Is Nothing Then
    If Target.Value = "" Then
        Me.Range("A3:U3").AutoFilter Field:=Target.Column
    Else
        Me.Range("A3:U3").AutoFilter Field:=Target.Column, _
            Operator:=xlFilterValues, _
            Criteria1:="*" & CStr(Target.Value) & "*"
    End If
ElseIf Not Intersect(Target, [A1:V1]) Is Nothing Then
    If Target.Value = "" Then
        Me.Range("A3:U3").AutoFilter Field:=Target.Column
    Else
        Me.Range("A3:U3").AutoFilter Field:=Target.Column, _
            Operator:=xlFilterValues, _
            Criteria1:=CStr(Target.Value)
    End If
ElseIf Not Intersect([G:G], Target) Is Nothing Then
    If Target = "**" Then Target = WorksheetFunction.Max([G:G]) + 1
End If
Me.Protect DrawingObjects:=False, Contents:=True, _
           Scenarios:=False, AllowFormattingCells:=True, _
           AllowFiltering:=True
Application.EnableEvents = True
End Sub


I have this VBA code in My sheet , but when I input date in L3 than it is not working,
I have tried by change Formatting by Text, Date, Custom etc. but not working.
I am new in VBA code, so please edit my VBA and than give me
 

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
What do you want the code to do if you enter a date in L3?

At the moment, your code tests whether you enter "**"

If you do, the code puts today's date in L3.

Otherwise, the code does nothing.
 
Upvote 0
What do you want the code to do if you enter a date in L3?

At the moment, your code tests whether you enter "**"

If you do, the code puts today's date in L3.

Otherwise, the code does nothing.
I want that if I type "**" in L1 than todays' date is auto enter in L1 and auto filter from L3:L1000.

After enter "**" in L1 than date is coming, but auto filter not working
 
Upvote 0
If you change L1, then this piece of code will execute:

VBA Code:
If Not Intersect(Target, [B:B,L:L]) Is Nothing Then
    If Target.Value = "**" Then
        Target.Value = Date
        Target.NumberFormat = "DD/MM/YYYY"
    End If

You haven't got any code here to AutoFilter
 
Upvote 0
I am not following all your code either but if its is just that the filter is not working, try
Replacing this:
VBA Code:
        Me.Range("A3:U3").AutoFilter Field:=Target.Column, _
            Operator:=xlFilterValues, _
            Criteria1:=CStr(Target.Value)

With this:
VBA Code:
        Me.Range("A3:U3").AutoFilter Field:=Target.Column, _
            Criteria1:=">=" & Target.Value2, _
              Operator:=xlAnd, Criteria2:="<" & Target.Value2 + 1
 
Upvote 0
I am not following all your code either but if its is just that the filter is not working, try
Replacing this:
VBA Code:
        Me.Range("A3:U3").AutoFilter Field:=Target.Column, _
            Operator:=xlFilterValues, _
            Criteria1:=CStr(Target.Value)

With this:
VBA Code:
        Me.Range("A3:U3").AutoFilter Field:=Target.Column, _
            Criteria1:=">=" & Target.Value2, _
              Operator:=xlAnd, Criteria2:="<" & Target.Value2 + 1
this is not working,

an error in VBA code displayed.

please merge with my VBA code and than give me, because I am new in VBA
 
Upvote 0
Did any of the filtering ever work ?

Give this a try:

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.CountLarge > 1 Then Exit Sub
Application.EnableEvents = False
Me.Unprotect
If Not Intersect(Target, [B1,L1]) Is Nothing Then
    If Target.Value = "" Then
        Me.Range("A2:U3").AutoFilter Field:=Target.Column
    Else
        If Target.Value = "**" Then
            Target.NumberFormat = "DD/MM/YYYY"
            Target.Value = Date
        End If
        Me.Range("A2:U3").AutoFilter Field:=Target.Column, _
            Criteria1:=">=" & Target.Value2, _
            Operator:=xlAnd, Criteria2:="<" & Target.Value2 + 1
    End If
ElseIf Not Intersect(Target, [E1]) Is Nothing Then
    If Target.Value = "" Then
        Me.Range("A2:U3").AutoFilter Field:=Target.Column
    Else
        Me.Range("A2:U3").AutoFilter Field:=Target.Column, _
            Operator:=xlFilterValues, _
            Criteria1:="*" & CStr(Target.Value) & "*"
    End If
ElseIf Not Intersect(Target, [A1:V1]) Is Nothing Then
    If Target.Value = "" Then
        Me.Range("A2:U3").AutoFilter Field:=Target.Column
    Else
        Me.Range("A2:U3").AutoFilter Field:=Target.Column, _
            Operator:=xlFilterValues, _
            Criteria1:=CStr(Target.Value)
    End If
ElseIf Not Intersect([G:G], Target) Is Nothing Then
    If Target = "**" Then Target = WorksheetFunction.Max([G:G]) + 1
End If
Me.Protect DrawingObjects:=False, Contents:=True, _
           Scenarios:=False, AllowFormattingCells:=True, _
           AllowFiltering:=True
Application.EnableEvents = True
End Sub
 
Upvote 0
Solution
Did any of the filtering ever work ?

Give this a try:

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.CountLarge > 1 Then Exit Sub
Application.EnableEvents = False
Me.Unprotect
If Not Intersect(Target, [B1,L1]) Is Nothing Then
    If Target.Value = "" Then
        Me.Range("A2:U3").AutoFilter Field:=Target.Column
    Else
        If Target.Value = "**" Then
            Target.NumberFormat = "DD/MM/YYYY"
            Target.Value = Date
        End If
        Me.Range("A2:U3").AutoFilter Field:=Target.Column, _
            Criteria1:=">=" & Target.Value2, _
            Operator:=xlAnd, Criteria2:="<" & Target.Value2 + 1
    End If
ElseIf Not Intersect(Target, [E1]) Is Nothing Then
    If Target.Value = "" Then
        Me.Range("A2:U3").AutoFilter Field:=Target.Column
    Else
        Me.Range("A2:U3").AutoFilter Field:=Target.Column, _
            Operator:=xlFilterValues, _
            Criteria1:="*" & CStr(Target.Value) & "*"
    End If
ElseIf Not Intersect(Target, [A1:V1]) Is Nothing Then
    If Target.Value = "" Then
        Me.Range("A2:U3").AutoFilter Field:=Target.Column
    Else
        Me.Range("A2:U3").AutoFilter Field:=Target.Column, _
            Operator:=xlFilterValues, _
            Criteria1:=CStr(Target.Value)
    End If
ElseIf Not Intersect([G:G], Target) Is Nothing Then
    If Target = "**" Then Target = WorksheetFunction.Max([G:G]) + 1
End If
Me.Protect DrawingObjects:=False, Contents:=True, _
           Scenarios:=False, AllowFormattingCells:=True, _
           AllowFiltering:=True
Application.EnableEvents = True
End Sub
not working
 
Upvote 0
That gives me nothing to go by since it works at my end.
Has any of the filter code ever worked ? The original code started at row 3 and it needs to start at row 2.

What does not working mean ?
Are you getting an error message and if so what is the message and what line is highlighted in the code ?
If no error message have you put a breakpoint on the code and hit F8 to see if it is performing the right if statement code ?
 
Upvote 0
That gives me nothing to go by since it works at my end.
Has any of the filter code ever worked ? The original code started at row 3 and it needs to start at row 2.

What does not working mean ?
Are you getting an error message and if so what is the message and what line is highlighted in the code ?
If no error message have you put a breakpoint on the code and hit F8 to see if it is performing the right if statement code ?

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.CountLarge > 1 Then Exit Sub
Application.EnableEvents = False
Me.Unprotect
If Not Intersect(Target, [B1,L1]) Is Nothing Then
    If Target.Value = "" Then
        Me.Range("A2:Y2").AutoFilter Field:=Target.Column
    Else
        If Target.Value = "**" Then
            Target.NumberFormat = "DD/MM/YYYY"
            Target.Value = Date
        End If
        Me.Range("A2:U3").AutoFilter Field:=Target.Column, _
            Criteria1:=">=" & Target.Value2, _
            Operator:=xlAnd, Criteria2:="<" & Target.Value2 + 1
    End If
ElseIf Not Intersect(Target, [E1]) Is Nothing Then
    If Target.Value = "" Then
        Me.Range("A2:U3").AutoFilter Field:=Target.Column
    Else
        Me.Range("A2:U3").AutoFilter Field:=Target.Column, _
            Operator:=xlFilterValues, _
            Criteria1:="*" & CStr(Target.Value) & "*"
    End If
ElseIf Not Intersect(Target, [A1:Y1]) Is Nothing Then
    If Target.Value = "" Then
        Me.Range("A2:Y3").AutoFilter Field:=Target.Column
    Else
        Me.Range("A2:Y3").AutoFilter Field:=Target.Column, _
            Operator:=xlFilterValues, _
            Criteria1:=CStr(Target.Value)
    End If
ElseIf Not Intersect(Target, [B:B,L:L]) Is Nothing Then
    If Target.Value = "**" Then
        Target.Value = Date
        Target.NumberFormat = "DD/MM/YYYY"
    End If
ElseIf Not Intersect([G:G], Target) Is Nothing Then
    If Target = "**" Then Target = WorksheetFunction.Max([G:G]) + 1
End If
Me.Protect DrawingObjects:=False, Contents:=True, _
           Scenarios:=False, AllowFormattingCells:=True, _
           AllowFiltering:=True
Application.EnableEvents = True
End Sub





this is working for me...excellent...thank you all replier.
 
Upvote 0

Forum statistics

Threads
1,224,810
Messages
6,181,079
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top