VBA code is not working

J

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

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Sort by date Sort by votes
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
StephenCrump said:
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.
Click to expand...
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
Alex Blakenburg said:
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
Click to expand...
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
Alex Blakenburg said:
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
Click to expand...
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
Alex Blakenburg said:
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 ?
Click to expand...

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
You must log in or register to reply here.

Similar threads

J
  • Solved
VBA to search or autofilter
Replies
2
Views
369
Jagat Pavasia
J
excelbytes
  • Solved
Looping Procedure In VBA Code
2 3
Replies
24
Views
454
excelbytes
excelbytes
S
  • Question Question
VBA Script to merge cells based on cell value
Replies
1
Views
124
Joe4
Joe4
T
  • Solved
Help with VBA Code in Excel
Replies
2
Views
306
tixarah
T
M
  • Solved
Trying to apply 2 Worksheet Changes
Replies
1
Views
163
Joe4
Joe4

Forum statistics

Threads
1,223,876
Messages
6,175,123
Members
452,614
Latest member
MRSWIN2709

Share this page

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