• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Excel VBA Object Variable or With Block Variable Not Set Error

BeachDog_2600

New Member
Hello!

I'm trying to figure out where I'm going wrong with my code. Basically I want my code to decide what protections to initiate and how to proceed based on the data in column C on the 'LOA' tab. My table starts at A8 (headers) and is dynamic. My code should be allowing user entry from C9 to last row and only allowing users to edit columns A-B & H-O if there is data selected in Column C for that row. I had to adjust some of the ranges and that's where I started receiving the error. My original code allowed users to edit the headers because there was data in C8 so I tried to update the code to prevent that.

My current code is below:

Code:
Private Sub Workbook_Open()
    Dim ws As Worksheet
    Dim wsRef As Worksheet
    Dim lastRow As Long
    Dim lastRowRef As Long
    
    ' Set worksheet references
    Set ws = ThisWorkbook.Sheets("LOA")
    Set wsRef = ThisWorkbook.Sheets("References")
    
    ' Unprotect workbook and sheets
    ThisWorkbook.Unprotect "123456"
    ws.Unprotect "123456"
    wsRef.Unprotect "123456"
    
    ' Sort data on LOA sheet
    lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
    ws.Sort.SortFields.Clear
    ws.Sort.SortFields.Add Key:=ws.Range("C8:C" & lastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ws.Sort
        .SetRange ws.Range("A8:O" & lastRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    ' Set up data validation for Employee Name
    lastRowRef = wsRef.Cells(wsRef.Rows.Count, "A").End(xlUp).Row
    With ws.Range("C9:C" & lastRow).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=References!$A$2:$A$" & lastRowRef
    End With
    
    ' Set formulas for columns D-G
    ws.Range("D9:D" & lastRow).Formula = "=VLOOKUP(C9,References!$A$2:$G$" & lastRowRef & ",2,FALSE)"
    ws.Range("E9:E" & lastRow).Formula = "=VLOOKUP(C9,References!$A$2:$G$" & lastRowRef & ",3,FALSE)"
    ws.Range("F9:F" & lastRow).Formula = "=VLOOKUP(C9,References!$A$2:$G$" & lastRowRef & ",4,FALSE)"
    ws.Range("G9:G" & lastRow).Formula = "=VLOOKUP(C9,References!$A$2:$G$" & lastRowRef & ",5,FALSE)"
    
    ' Find the last row with data in column C
    lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
    
    ' Set the range for column C
    Set dataRange = ws.Range("C9:C" & lastRow)
    
    ' Loop through each cell in column C
    For Each cell In dataRange
        If Not IsEmpty(cell) Then
            ' Unlock corresponding cells in A, B, and H-O
            ws.Range("A" & cell.Row & ":B" & cell.Row).Locked = False
            ws.Range("H" & cell.Row & ":O" & cell.Row).Locked = False
        Else
            ' Lock corresponding cells in A, B, and H-O
            ws.Range("A" & cell.Row & ":B" & cell.Row).Locked = True
            ws.Range("H" & cell.Row & ":O" & cell.Row).Locked = True
        End If
    Next cell
    
    ws.Range("C9:C" & lastRow).Locked = False
    
    ' Protect LOA sheet
    ws.Protect "123456", UserInterfaceOnly:=True, AllowFiltering:=True, AllowSorting:=True
    
    ' Protect References sheet
    wsRef.Protect "123456"
    
    ' Protect workbook
    ThisWorkbook.Protect "123456"
End Sub

Option Explicit

Private Const WARNING_MESSAGE As String = "Warning: You are attempting to {0} data." & vbNewLine & _
    "That is not allowed in this spreadsheet. Please press 'ESC' to return to your work."

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    Dim lastRow As Long
    On Error GoTo ErrorHandler
    
    lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
    If Not Intersect(Target, Me.Range("C9:C" & lastRow)) Is Nothing Then
        Application.EnableEvents = False
        Me.Unprotect "123456"
        
        UpdateCellLockStatus Target
        
        Me.Protect "123456", UserInterfaceOnly:=True, AllowFiltering:=True, AllowSorting:=True
    End If

ExitSub:
    Application.EnableEvents = True
    Exit Sub

ErrorHandler:
    MsgBox "An error occurred: " & Err.Description, vbCritical, "Error"
    Resume ExitSub
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Application.CutCopyMode = False Then
        Select Case Application.CutCopyMode
            Case xlCut
                ShowWarningMessage "cut"
            Case xlCopy
                ShowWarningMessage "copy"
        End Select
    End If
End Sub

Private Sub UpdateCellLockStatus(ByVal Target As Range)
    Dim cell As Range
    Dim affectedRange As Range
    
    For Each cell In Intersect(Target, Me.Range("C9:C" & lastRow))
        Set affectedRange = Union(Me.Range("A" & cell.Row & ":B" & cell.Row), _
                                  Me.Range("H" & cell.Row & ":O" & cell.Row))
        
        affectedRange.Locked = (cell.Value = "")
    Next cell
End Sub

Private Sub ShowWarningMessage(ByVal action As String)
    MsgBox Replace(WARNING_MESSAGE, "{0}", action), vbExclamation + vbOKOnly, "Data Modification Warning"
End Sub

Private Sub Worksheet_Change_Paste(ByVal Target As Range)
    If Not Application.CutCopyMode = False Then
        ShowWarningMessage "paste"
    End If
End Sub

Option Explicit

Sub AddNewRowToTable()
    
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim table_object_row As ListRow
    
    ' Set references to the worksheet and table
    Set ws = ThisWorkbook.Worksheets("LOA")  ' Replace "Sheet1" with your sheet name
    Set tbl = ws.ListObjects(1)  ' Replace "Table1" with your table name

    ' Unprotect workbook and sheets
    ws.Unprotect "123456"
    
    Set table_object_row = tbl.ListRows.Add
    table_object_row.Range(1, 1).Value = ""
    
    ' Protect LOA sheet
    ws.Protect "123456", UserInterfaceOnly:=True, AllowFiltering:=True, AllowSorting:=True
End Sub

I'm also trying to add code that will delete all of the data in a row (without removing data validations or formatting) when the data in Column C is deleted. I tried the following code, but I wasn't sure how to implement it.

Code:
Option Explicit

Private Const WARNING_MESSAGE_DEL As String = "Warning: You are attempting to delete data in Column C." & vbNewLine & _
    "This action will clear the entire row. Do you want to proceed?"
    
Private Sub Worksheet_BeforeDelete(ByVal Target As Range, Cancel As Boolean)
    Dim intersectRange As Range
    
    ' Check if the deletion involves Column C
    Set intersectRange = Intersect(Target, Me.Columns("C"))
    
    If Not intersectRange Is Nothing Then
        If MsgBox(WARNING_MESSAGE_DEL, vbExclamation + vbYesNo, "Deletion Warning") = vbNo Then
            Cancel = True
        End If
    End If
End Sub

Private Sub ClearRowExceptColumnC(ByVal rowNumber As Long)
    ' Clear cells to the left of Column C
    Me.Range("A" & rowNumber & ":B" & rowNumber).ClearContents
    
    ' Clear cells to the right of Column C
    Me.Range("D" & rowNumber & ":" & Me.Cells(rowNumber, Columns.Count).Address).ClearContents
End Sub

I'm very much a novice when it comes to VBA, but I love the customizability and am trying to learn more. If you have any other advice it would be very much appreciated!
 
Difficult to say, best attach your actual workbook with code so that we know where all this code is.
At first glance, and a big guess, there's a line:
Code:
lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
which might well cause such an error since ws hasn't been set at the point it's being used.
For context, the code is here:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim lastRow As Long
On Error GoTo ErrorHandler
  
lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
where you probably don't need to Dim ws, nor use ws at all; try losing the Dim ws as Worksheet and changing the other line to:
Code:
lastRow = Cells(Rows.Count, "C").End(xlUp).Row
(Since the code is in a sheet's code module, all unqualified references to ranges are for that sheet, whether it's the active sheet or not)
 
Thank you everyone for your help and advice! I fixed that error, but now I'm having an error with a different section of my code. There is a section on the worksheet module to prompt the user when they attempt to delete data in Column C (starting in C9 to lastrow), but I'm having a issue with the undo function. It deletes the row just fine when I select 'Yes', but when I select 'Cancel' it gives me 'Run-time error '1004': Method 'Undo' of object '_Application' failed'. Is there a different method I could use or am I using '.undo' incorrectly? The specific piece of code is below (starts at 24) and my spreadsheet is attached.

Code:
Option Explicit

Private Const WARNING_MESSAGE As String = "Warning: You are attempting to {0} data." & vbNewLine & _
    "That is not allowed in this spreadsheet. Please press 'ESC' to return to your work."

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lastRow As Long
    Dim intersectRange As Range
    Dim YesNo As VbMsgBoxResult
    On Error GoTo ErrorHandler
    
    lastRow = Cells(Rows.Count, "C").End(xlUp).Row
    Set intersectRange = Intersect(Target, Me.Range("C9:C" & lastRow))
    
    If Not Intersect(Target, Me.Range("C9:C" & lastRow)) Is Nothing Then
        Application.EnableEvents = False
        Me.Unprotect "123456"
        
        UpdateCellLockStatus Target
        
        Me.Protect "123456", UserInterfaceOnly:=True, AllowFiltering:=True, AllowSorting:=True
    End If

    If Not intersectRange Is Nothing Then
        If IsEmpty(Target) Then ' Content was deleted
            YesNo = MsgBox("Warning: You are attempting to delete data in Column C." & vbNewLine & _
                           "This action will clear the entire row. Do you want to proceed?", vbOKCancel)
            If YesNo = vbOK Then ' If OK clicked
                With Application
                    .ScreenUpdating = False
                    .EnableEvents = False
                        Target.EntireRow.Delete ' Delete data in Column C
                    .ScreenUpdating = True
                    .EnableEvents = True
                End With
            ElseIf YesNo = vbCancel Then ' If Cancel clicked
                With Application
                    .EnableEvents = False
                        .Undo
                    .EnableEvents = True
                End With
            End If
        End If
    End If
    
ExitSub:
    Application.EnableEvents = True
    Exit Sub
    
ErrorHandler:
    MsgBox "An error occurred: " & Err.Description, vbCritical, "Error"
    Resume ExitSub

End Sub
 

Attachments

  • LOA Spreadsheet - Example to Upload.xlsm
    50.5 KB · Views: 6
What about? (Without a decent example.)
Code:
 ElseIf YesNo = vbCancel Then ' If Cancel clicked
 Cancel = True
   'Exit Sub
End If
End Sub
 

BeachDog_2600

Question ... Can You Undo something?

This method undoes only the last action taken by the user before running the macro, and it must be the first line in the macro. It cannot be used to undo Visual Basic commands.

I would use UserInterfaceOnly:=True only while opening file.
Many times after that You could avoid Protect ... UnProtect -swapping.
You could find many pages of that - do some research please.
 
Back
Top