macro to lock cell by column header based on value in another cell by column header

Hi Closet Guru,

try this one:

Sub LockexistingCustomers()
    Dim CustomerCol As Integer
    Dim StatusCol As Integer
    Dim i As Integer
    Dim FirstDataRow As Double
    Dim LastRow As Double
    Dim SheetPW As String

    '_________________________________
    'Adjust for your file here
    CustomerCol = 1    'A=1, B=2, C=3 ...
    StatusCol = 2    'A=1, B=2, C=3 ...
    FirstDataRow = 2    'The first row below your header
    SheetPW = "lock"    'Password for your worksheet
    '_________________________________
    
    'unprotect Sheet
    ActiveSheet.Unprotect SheetPW
    'unprotect all cells
    ActiveSheet.Cells.Locked = False
    'Determine the last row
    LastRow = ActiveSheet.Cells(Rows.Count, CustomerCol).End(xlUp).Row
    'Loop through all rows
    For i = FirstDataRow To LastRow
        If InStr(1, LCase(ActiveSheet.Cells(i, StatusCol)), LCase("New Prospect")) = 0 Then    'checking on lower case to avoid case sensiteveness
            'no new prospect - lock cell
            ActiveSheet.Cells(i, CustomerCol).Locked = True
        End If
    Next i
    'Protect Sheet again
    ActiveSheet.Protect SheetPW
End Sub

Don't forget to adjust the values in the first section to "your" values.

Let me know if this is what you need.

Theo

Hi ClosetGuru,
sure, just use the macro below (don't forget to adjust the correct Column Header Names):

Sub LockexistingCustomers()
    Dim CustomerCol As Integer
    Dim StatusCol As Integer
    Dim i As Integer
    Dim FirstDataRow As Double
    Dim LastRow As Double
    Dim SheetPW As String
    Dim CustomerHeaderName As String
    Dim StatusHeaderName As String
    Dim rngCell As Range
    '_________________________________
    'Adjust for your file here

    FirstDataRow = 2    'The first row below your header
    SheetPW = "lock"    'Password for your worksheet
    CustomerHeaderName = "Customer"    'Title of the columnheader where the Customner can be found
    StatusHeaderName = "Status"    'Title of the colmnheader which keeps the status informaton
    '_________________________________

    'Find correct Columns
    Set rngCell = ActiveSheet.Rows(FirstDataRow - 1).Find(CustomerHeaderName, lookat:=xlWhole, LookIn:=xlValues, MatchCase:=True)
    If Not rngCell Is Nothing Then
        CustomerCol = rngCell.Column
    End If
    Set rngCell = ActiveSheet.Rows(FirstDataRow - 1).Find(StatusHeaderName, lookat:=xlWhole, LookIn:=xlValues, MatchCase:=True)
    If Not rngCell Is Nothing Then
        StatusCol = rngCell.Column
    End If


    'unprotect Sheet
    ActiveSheet.Unprotect SheetPW
    'unprotect all cells
    ActiveSheet.Cells.Locked = False
    'Determine the last row
    LastRow = ActiveSheet.Cells(Rows.Count, CustomerCol).End(xlUp).Row
    'Loop through all rows
    For i = FirstDataRow To LastRow
        If InStr(1, LCase(ActiveSheet.Cells(i, StatusCol)), LCase("New Prospect")) = 0 Then    'checking on lower case to avoid case sensiteveness
            'no new prospect - lock cell
            ActiveSheet.Cells(i, CustomerCol).Locked = True
        End If
    Next i
    'Protect Sheet again
    ActiveSheet.Protect SheetPW
set rngCell = nothing
End Sub

Let me know if it works now, and don't forget to mark the thread as "Solved" if it does.

Have a happy Easter

Theo