VBA code is not working

J

Jagat Pavasia

Active Member
Joined
Mar 9, 2015
Messages
404
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

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
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
285
Jagat Pavasia
J
T
  • Question
Help with VBA Code in Excel
Replies
1
Views
78
Skyybot
Skyybot
J
  • Question
Combining VBA Codes
Replies
4
Views
209
DanteAmor
DanteAmor
N
  • Solved
VBA Question
Replies
3
Views
353
RoryA
RoryA
SaraWitch
  • Solved
Run Multiple Private Sub Worksheet_Change(ByVal Target As Range)
Replies
5
Views
457
Joe4
Joe4

Forum statistics

Threads
1,221,304
Messages
6,159,145
Members
451,541
Latest member
rdpattea

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