Column Protect if Current Date is Passed

Hi All,
I have sheet where date are given in column from 1st day of month to last day of month like...01-01-2012.........01-31-2012
what i acctualy want if the date is given in column A is less than current date then column A automaticaly protect and so on.....

please help me out

Thanks & Regards,
Abdul

Hi

Do you need it only with VBA code?

Because you can do it using Custom Validation, also.

Sorry. My knowdledge in VBA, is very poor...

Please post an example workbook and i'll take a look.

Im not sure from your explanation if all the dates are populated in column A vertically or if they are in Row 1 and populated horizontally.

Thanks

Hi,

Dates are populated horizentally in row 1. what i want check if column B1 date is less then current date then column B locked, and then go to check column C1 date is less than current date then column c locked and so on...

I am also attaching the format file.

please provide the macro it's urgent.

Hi

Please be more patient when waiting for help.

Thanks

McC

Private Const PC_ROW_DATE As Integer = 1

Public Sub LockColumnsBasedOnCurrentDate()
    
    Dim lngCol As Long
    
    Worksheets("Sheet1").Protect UserInterfaceOnly:=True

    For lngCol = 2 To Range("A" & PC_ROW_DATE).CurrentRegion.Columns.Count
        If Cells(PC_ROW_DATE, lngCol) > Date Then
            Columns(lngCol).Locked = False
        End If
    Next lngCol
    
End Sub

PS - If this sorts your problem then please mark the thread as solved and feel free to add reputation if this meets your requirements.

Please find attached:

Private Const PC_ROW_DATE As Integer = 1

Public Sub LockColumnsBasedOnCurrentDate()
    
    Dim lngCol As Long
    
    Worksheets("Sheet1").Unprotect

    For lngCol = 2 To Range("A" & PC_ROW_DATE).CurrentRegion.Columns.Count
        If Cells(PC_ROW_DATE, lngCol) < Date Then
            Columns(lngCol).Locked = True
        End If
    Next lngCol
    
    Worksheets("Sheet1").Protect UserInterfaceOnly:=True
    
End Sub

Please start your own thread, petre. "Hijacking" of old threads is against the forum rules. See rule 2

hi
Abdul, the code provided by mccrimmon works fine for me! it's a great job! I use it! thx man!
see the file attached.

Abdul,
see the forum rules
or
(...)
9. Acknowledge the responses you receive, good or bad. If your problem is solved, please say so clearly, and mark your thread as Solved: Click the Edit button on your first post in the thread, Click Go Advanced, select [SOLVED] from the Prefix dropdown, then click Save Changes.

hi Abdul
as an option, try to change the pc date and see if it heps you

Private Sub Workbook_Open()
Const PC_ROW_DATE As Integer = 1

Worksheets("Sheet1").Unprotect

    
    Dim lngCol As Long
    
   
    For lngCol = 2 To Range("A" & PC_ROW_DATE).CurrentRegion.Columns.Count
        If Cells(PC_ROW_DATE, lngCol) < Date Then
            Columns(lngCol).Locked = 1
            Else
            Columns(lngCol).Locked = 0
        End If
    Next lngCol
    
 Worksheets("Sheet1").Protect UserInterfaceOnly:=True

End Sub

well, hope it works! glad I could help!

Abdul, I'd like to help you but regarding the sharing of the workbook I know nothing! I'm sorry!
maybe someone else might help you!

Hi
I find out the solution for sharing workbook now this code will run on share workbook.

Private Sub Workbook_Open()
 Application.DisplayAlerts = False
 ActiveWorkbook.ExclusiveAccess
 Application.DisplayAlerts = True
 Worksheets("Daily-India").Unprotect
Const PC_ROW_DATE As Integer = 1
    Dim lngCol As Long
       
    For lngCol = 2 To Range("A" & PC_ROW_DATE).CurrentRegion.Columns.Count
        If Cells(PC_ROW_DATE, lngCol) < Date Then
            Columns(lngCol).Locked = 1
            Else
            Columns(lngCol).Locked = 0
        End If
    Next lngCol
  Worksheets("Daily-India").Protect
  Application.DisplayAlerts = False
  ActiveWorkbook.KeepChangeHistory = True
  ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.FullName, AccessMode:=xlShared
  Application.DisplayAlerts = True
  
End Sub