Help with VB macros

Microsoft Excel 2003 (full product)
October 13, 2009 at 00:24:46
Specs: Windows XP
Hi I am using the following VB code that Edits Excel Cell only ONCE!. but I cannot use Autofilter after I save the workbook. Can u help me in this. My code is as below: Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
ActiveSheet.Unprotect Password:="Nirvana99*"
ActiveSheet.Protect Contents:=False
For Each cell In Range("A3:F65536")
If cell "" Then cell.Locked = True
Next
ActiveSheet.Protect Contents:=True
ActiveSheet.Protect Password:="Nirvana99*"
MsgBox "Inorder to ensure maximum protection of your Inputs, please save this organizer from Home page also.", vbOKOnly, "Input Complete"
End Sub

See More: Help with VB macros

Report •


#1
October 13, 2009 at 05:54:06
The problem is that the sheet is protected at the end of your cdoe, this means that you will be able to use autofilter unless you specify in the code that you want to allow the use of autofilter.I have made some changes to your code just to make it work a little better. i have also added a comment on how to apply the filter. There may be better ways but here is one

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim BCell As Range

ActiveSheet.Unprotect Password:="Nirvana99*"
ActiveSheet.Protect contents:=False

For Each BCell In Range("A3:F65536")

If BCell.Value = Empty Then
BCell.Locked = True
Else
BCell.Locked = False
End If

Next BCell


ActiveSheet.Protect Password:="Nirvana99*", DrawingObjects:=True, _
contents:=True, Scenarios:=True, AllowFiltering:=True, _
userinterfaceonly:=True

MsgBox "Inorder to ensure maximum protection of your Inputs, please save this organizer from Home page also.", vbOKOnly, "Input Complete"

End Sub


TO APPLY FILTER
Highligh the headings of the coulms you want the filter to apply to, then right click the selection and select "Filter" then when this expands select "Filter by selected values" Autofilter will be applied to your columns.

Hope this helps.

Bunty


Report •

#2
October 13, 2009 at 06:53:02
Thanks for this.. But the main idea of the sheet is to prevent the users from editing any data once they have saved it. Here we are opening the sheet so cells can be edited.. pls. correct me if I am wrong.. I made a slight change to the code as below and the sheet is working just fine... Thanks Bunty...Can you help me in preventing duplicate enteries in multiple columns in the same sheet..

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim BCell As Range

ActiveSheet.Unprotect Password:="Nirvana99*"
ActiveSheet.Protect contents:=False

For Each BCell In Range("A3:F65536")

If BCell.Value = Empty Then
BCell.Locked = False
Else
BCell.Locked = True
End If

Next BCell

ActiveSheet.Protect Password:="Nirvana99*", DrawingObjects:=True, _
contents:=True, Scenarios:=True, AllowFiltering:=True, _
userinterfaceonly:=True

MsgBox "Inorder to ensure maximum protection of your Inputs, please save this organizer from Home page also.", vbOKOnly, "Input Complete"

End Sub


Report •

#3
October 13, 2009 at 07:17:48
Have you run the code i sent? this code does exactly what your one does. But in addition if the cell is empty it will lock the cell, if the cell is NOT empty it will unlock that cell. is this correct? i just assumed that would be the correct way, if not then take that piece of code out.

Explain what you need in more detail please.


Report •

Related Solutions

#4
October 13, 2009 at 07:23:39
I made a slight change to the code as below and the sheet is working just fine... Thanks Bunty...Can you help me in preventing duplicate enteries in multiple columns in the same sheet..

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim BCell As Range

ActiveSheet.Unprotect Password:="Nirvana99*"
ActiveSheet.Protect contents:=False

For Each BCell In Range("A3:F65536")

If BCell.Value = Empty Then
BCell.Locked = False
Else
BCell.Locked = True
End If

Next BCell

ActiveSheet.Protect Password:="Nirvana99*", DrawingObjects:=True, _
contents:=True, Scenarios:=True, AllowFiltering:=True, _
userinterfaceonly:=True

MsgBox "Inorder to ensure maximum protection of your Inputs, please save this organizer from Home page also.", vbOKOnly, "Input Complete"

End Sub


Report •

#5
October 13, 2009 at 07:41:04
Give this code a bash

place is under ThisWorkBook

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

On Error Resume Next

If IsEmpty(Target.Value) Then Exit Sub

If Target.Count > 1 Then Exit Sub


With Range(Cells(1, Target.Column).Address & ":" & Cells(Target.Row - 1, Target.Column).Address & "," & Cells(Target.Row + 1, Target.Column).Address & ":" & Cells(Rows.Count, Target.Column).Address)
Set c = .Find(Target.Value, , , xlWhole)
If Not c Is Nothing Then
MsgBox "Data already exists at range: " & c.Address(0, 0)
Target.Value = ""
End If
End With
End Sub


It works column by column so if you put "A" is Range A1 and then "A" in Range A6 if will through you an error that the value already exists - but it will not work accros the page is in it will not validate column A against B and so on..


Report •

#6
October 13, 2009 at 07:50:16
Thanks for this but let me explain what i am looking at: My excel sheet has columns as below:
A B C D
1 Date of Meeting Start Time End Time Status

I want that if any user chooses a start time for a date that has already been entered by someone else to be prevented. I hope this explains....


Report •

#7
October 13, 2009 at 08:26:44
So all you need to do is prevent a duplicate for the DATE??

this is simply done by modifying the code.

Assumptions:

Column A = Date of Meeting
Column B = Start Time
Column C = End Time
Column D = Status

So you want to prevent a duplicate date in Coulmn A heres how.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

On Error Resume Next

If Target.Column = 1 Then
If IsEmpty(Target.Value) Then Exit Sub

If Target.Count > 1 Then Exit Sub


With Range(Cells(1, Target.Column).Address & ":" & Cells(Target.Row - 1, Target.Column).Address & "," & Cells(Target.Row + 1, Target.Column).Address & ":" & Cells(Rows.Count, Target.Column).Address)
Set c = .Find(Target.Value, , , xlWhole)
If Not c Is Nothing Then
MsgBox "Data already exists at range: " & c.Address(0, 0)
Target.Value = ""
End If
End With
End If
End Sub


Report •

#8
October 13, 2009 at 10:11:17
Well I will explain again. I want to prevent same START TIME for the same DATE. EX.

User1:
Column A = Date of Meeting - 29-OCT-09
Column B = Start Time - 02:00 PM
Column C = End Time 03:00 PM
Column D = Status

Now if any user say user selects date as 29-OCT-09 and Start Time as 02:00 PM it should prompt a mssg as duplicate entry etc. At the same time a user can choose any time for 29-OCT-09. Also, we need to keep in mind that for any other date the same time 2 PM in this case can be choosen.


Report •


Ask Question