Help with user form code, Object Variable or with Block Variable not set.

[Bill Williamson]

Hello,

I have been modifying this code from another User form that I use since it had many of the same attributes I needed.
However I am getting a run time error 91 Object Variable or with block Variable not set.

Any Help is appreciated.


Here is a link to file
Stainless Data Entry Test.xlsm

Option Base 1
Dim WSData As Worksheet
Dim RecordRow As Long
Dim Fnd As Range
Dim FilterCount As Long
Enum XLRecordActionType
    xlUpdateRecord = 1
    xlAddRecord = 2
    xlGetRecord = 3

End Enum



'**************************TEXTBOX CODE***************************************

Private Sub Customer_Change()
    ButtonsEnable
End Sub


Private Sub CSONumber_Change()
   ButtonsEnable
End Sub


Private Sub JobNumber_Change()
    ButtonsEnable
End Sub


'****************************BUTTONS CODE****************************************

Private Sub CMDUpdate_Click()
   AddUpdateRecord xlUpdateRecord
End Sub



Private Sub AddButton_Click()
    AddUpdateRecord xlAddRecord
End Sub


Private Sub ClearButton_Click()
    ClearForm
End Sub


Private Sub CBPrev_Click()
    Set Fnd = WSData.Columns(1).FindPrevious(Fnd)
    If Not Fnd Is Nothing Then
        RecordRow = Fnd.Row
        AddGetRecord xlGetRecord
        EnableNavigationButtons xlPrevious
    End If
End Sub


Private Sub CBNext_Click()
    Set Fnd = WSData.Columns(1).Find(Me.Customer.Text, after:=Fnd, LookIn:=xlValues, lookat:=xlWhole)
    If Not Fnd Is Nothing Then
        RecordRow = Fnd.Row
        AddGetRecord xlGetRecord
        EnableNavigationButtons xlNext
    End If
End Sub


Private Sub CancelButton_Click()
   ' WSData.AutoFilterMode = False
    Unload Me
End Sub


Private Sub CMDSearch_Click()
    Dim i As Integer
    Dim ControlsArr As Variant
    Dim FilterRange As Range
    
    ControlsArr = FormControls
    
    If WSData.AutoFilterMode Then WSData.AutoFilterMode = False    '[B][COLOR=rgb(184, 49, 47)] ( *************THIS IS WHERE IT HANGS UP**************** )[/COLOR][/B]
    
    For i = 1 To 3
        With Me.Controls(ControlsArr(i))
            If Len(.Text) > 0 Then WSData.Range("A1").AutoFilter i, .Text
        End With
    Next i
        
    On Error Resume Next
        Set Fnd = WSData.Range("A2:A" & WSData.Rows.Count).SpecialCells(xlVisible)(1)
        Set FilterRange = WSData.AutoFilter.Range
    On Error GoTo 0
        
    If FilterRange Is Nothing Then Exit Sub
        
    FilterCount = FilterRange.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
        
    If FilterCount = 0 Then
        MsgBox "Search term not found", 48, "Not Found"
        Me.CMDUpdate.Enabled = False
    Else
        RecordRow = Fnd.Row
        AddGetRecord xlGetRecord
        Me.CMDUpdate.Enabled = True
    End If
'Turns off auto filter, shows all data
       ' WSData.AutoFilterMode = False
        Me.AddButton.Enabled = Not Me.CMDUpdate.Enabled
        EnableNavigationButtons 0
    End Sub


'**************************BUTTONS ENABLE CODE*******************************************

Sub EnableNavigationButtons(ByVal Direction As XlSearchDirection)
    Static Index As Integer
    Dim RecordCount As Integer
    RecordCount = FilterCount
    Index = IIf(Direction = xlPrevious, Index - 1, IIf(Direction = xlNext, Index + xlNext, xlFirst))
    Me.CBNext.Enabled = CBool(RecordCount > 1 And Index < RecordCount - 1)
    Me.CBPrev.Enabled = CBool(Index > 0)
End Sub



Sub ButtonsEnable()
    Dim ControlsArr As Variant
    Dim State As Boolean
    Dim i As Integer
    ControlsArr = FormControls
    
    For i = 1 To 3
        State = Len(Me.Controls(ControlsArr(i)).Text) > 0
        If State Then Exit For
    Next i
    Me.AddButton.Enabled = State
    Me.ClearButton.Enabled = State
    Me.CMDSearch.Enabled = State
    Me.ClearButton.Enabled = State
    'Me.AddButton.Enabled = Not Me.CMDUpdate.Enabled
End Sub
'******************************************************************************************



    Sub AddUpdateRecord(ByVal Action As XLRecordActionType)
        Dim i As Integer
        Dim Answer As VbMsgBoxResult
        Dim ControlsArr As Variant, RecordExists(1 To 3) As Variant
        
        ControlsArr = FormControls
        
'ensure first 3 fields have data
        For i = 1 To 3
            With Me.Controls(ControlsArr(i))
                If Len(.Text) = 0 Then
                    .SetFocus
                    MsgBox "Please Enter " & Choose(i, "Customer", "CSO Number", "Job Number"), 48, "Entry Required"
                    Exit Sub
                Else
                    RecordExists(i) = .Text
                End If
            End With
        Next i
            
        If Action = xlAddRecord Then
            If IsDuplicate(Me, WSData, RecordExists) Then Exit Sub
        End If
            
        If Action = xlUpdateRecord Then
            Answer = MsgBox("Are you sure you want to update?", vbYesNo + vbQuestion, "Update Record")
            If Answer = vbNo Then Exit Sub
        End If
            
        AddGetRecord Action
            
        msg = IIf(Action = xlUpdateRecord, "Updated", "Added")
        MsgBox "Record " & msg & " To Worksheet", 64, "Record " & msg
        If Action = xlAddRecord Then ClearForm
        
End Sub



Private Sub ClearForm()
  Dim ctrl As MSForms.Control
  For Each ctrl In Me.Controls
    Select Case TypeName(ctrl)
      Case "TextBox"
        ctrl.Text = ""
    
    End Select
  Next
  Me.CMDUpdate.Enabled = False
  Me.AddButton.Enabled = False
  FilterCount = 0
  EnableNavigationButtons xlFirst
  Me.Customer.SetFocus
  WSData.AutoFilterMode = False
End Sub



Sub AddGetRecord(ByVal Action As XLRecordActionType)
    Dim i As Integer
    Dim ControlsArr As Variant
    
    ControlsArr = FormControls
 
    If Action = xlAddRecord Then RecordRow = WorksheetFunction.CountA(WSData.Range("A:A"))
    
    For i = 1 To 15
        With Me.Controls(ControlsArr(i))
            If i < 10 Then
                If Action = xlGetRecord Then
                    .Text = WSData.Cells(RecordRow, i).Value
                Else
                    WSData.Cells(RecordRow, i).Value = .Value
                End If
            Else
                If Action = xlGetRecord Then
                    .Value = CBool(LCase(WSData.Cells(RecordRow, i).Value) = "yes")
                Else
                     WSData.Cells(RecordRow, i).Value = IIf(.Value, "Yes", "No")
                End If
            End If
        End With
    Next i
End Sub



Function FormControls() As Variant
    FormControls = Array("Customer", "CSONumber", "JobNumber", _
                        "PartDescription", "PartNumber", "Quantity", _
                        "Tacker", "Welder", "Issues")
End Function



Function IsDuplicate(ByVal Form As Object, ByVal sh As Object, ByVal Arr As Variant) As Boolean
    Dim FoundCell As Range
    Dim Search As String, FirstAddress As String
'checks values in textboxes for new records are not duplicated
    Search = Arr(1)
  
    Set FoundCell = sh.Columns(1).Find(Search, LookIn:=xlValues, lookat:=xlWhole)
    If Not FoundCell Is Nothing Then
    FirstAddress = FoundCell.Address
        Do
        With FoundCell
            IsDuplicate = CBool(UCase(.Offset(, 1).Value) = UCase(Arr(2)) And _
                                UCase(.Offset(, 2).Value) = UCase(Arr(3)))
        End With
        If IsDuplicate Then
        MsgBox "Duplicate Entry", 48, "Duplicate"
        Exit Function
        End If
        Set FoundCell = sh.Columns(1).FindNext(FoundCell)
        Loop Until FoundCell.Address = FirstAddress
    End If
End Function



'button status
    Me.CMDUpdate.Enabled = False
    Me.AddButton.Enabled = False
    ButtonsEnable
    EnableNavigationButtons xlFirst
    WSData.AutoFilterMode = False
    Me.Customer.SetFocus
End Sub

Thanks,

Bill Williamson

 

[Bill Williamson]

It has something to do with how I am Declaring the WSData.
I have been able to get some button functions to work by Commenting out lines such as
" WSData.AutoFilterMode=False "


Thanks,

Bill Williamson

 

[Bill Williamson]

I solved the original problem, It appears when I copied the code I missed the UserForm Initialize section.
If I need to do this in a new thread please let me know.
But now trying to get my search to work properly.
The original Data this code was written for Had the three search criteria in the first three columns.
Which are Customer, CSO# and Job # .
here is a screen shot of original data Screenshot 2020-01-27 11.17.48.png


In the new sheet the First and second column have other data, and the customer starts in column C.
I thought I modified the code to search starting in column C, But it still Seems to be filtering the Data by column 1.

Any Help Is appreciated.

Here is how I modified the code.

Private Sub CMDSearch_Click()
    Dim i As Integer
    Dim ControlsArr As Variant
    Dim FilterRange As Range
    
    ControlsArr = FormControls
    
    If wsData.AutoFilterMode Then wsData.AutoFilterMode = False
    
    For i = 1 To 3
        With Me.Controls(ControlsArr(i))
            If Len(.Text) > 0 Then wsData.Range("C1").AutoFilter i, .Text
        End With
    Next i
        
    On Error Resume Next
        Set Fnd = wsData.Range("C2:C" & wsData.Rows.Count).SpecialCells(xlVisible)(1)
        Set FilterRange = wsData.AutoFilter.Range
    On Error GoTo 0
        
    If FilterRange Is Nothing Then Exit Sub
        
    FilterCount = FilterRange.Columns(3).SpecialCells(xlCellTypeVisible).Count - 1
        
    If FilterCount = 0 Then
        MsgBox "Search term not found", 48, "Not Found"
        Me.CMDUpdate.Enabled = False
    Else
        RecordRow = Fnd.Row
        AddGetRecord xlGetRecord
        Me.CMDUpdate.Enabled = True
    End If
'Turns off auto filter, shows all data
       ' WSData.AutoFilterMode = False
        Me.AddButton.Enabled = Not Me.CMDUpdate.Enabled
        EnableNavigationButtons 0
    End Sub

Thanks,

Bill Williamson

 

[Fluff]

Try

    For i = 1 To 3
        With Me.Controls(ControlsArr(i))
            If Len(.Text) > 0 Then wsData.Range("A1").AutoFilter i+2, .Text
        End With
    Next i

 

[Bill Williamson]

OK, I made the changes. Now it is searching in the correct column.
But when it filled the Userform the Data was not in the correct box's.


I had to also modify the sub below.

Sub AddGetRecord(ByVal Action As XLRecordActionType)
    Dim i As Integer
    Dim ControlsArr As Variant
    
    ControlsArr = FormControls
 
    If Action = xlAddRecord Then RecordRow = WorksheetFunction.CountA(wsData.Range("C:C"))
    
    For i = 1 To 15
        With Me.Controls(ControlsArr(i))     ' [COLOR=rgb(184, 49, 47)][B]***********************It Stops On This Line[/B][/COLOR] "
            If i < 10 Then
                If Action = xlGetRecord Then
                    .Text = wsData.Cells(RecordRow, i + 2).Value
                Else
                    wsData.Cells(RecordRow, i + 2).Value = .Value
                End If
            Else
                If Action = xlGetRecord Then
                    .Value = CBool(LCase(wsData.Cells(RecordRow, i + 2).Value) = "yes")
                Else
                     wsData.Cells(RecordRow, i + 2).Value = IIf(.Value, "Yes", "No")
                End If
            End If
        End With
    Next i

Screenshot 2020-01-27 13.43.03.png


the changes seemed to put the data in the proper rows, but Now I get a Run-Time Error 9
Subscript out of range. it Stops on the marked line above.

Thanks

Bill

 

[Bill Williamson]

in the new sheet the answer to check box 1 will be column V If its checked cell would display Yes, if unchecked it would say No
the Large text box would get data from Column K, in the original userform I copied this from had multiple check boxs.

 

[Fluff]

That's because you only have 9 values in the ControlsArr, but you are looping 1 to 15

 

[Bill Williamson]

Lightbulb going on over head........as head drops to desk.....

Thank you for that..

It is now filling all the text Box's properly.

In a feeble attempt to get the checkbox to work I modified the below code,
I changed the +2 to +21 thinking it would look in Column V, but it didn't work

 Else
                If Action = xlGetRecord Then
                    .Value = CBool(LCase(wsData.Cells(RecordRow, i + 21).Value) = "yes")
                Else
                     wsData.Cells(RecordRow, i + 21).Value = IIf(.Value, "Yes", "No")
                End If

Not sure if I was even on the right track...

Thanks,

Bill

 

[Fluff]

If you just want the value from col V replace i+21 with 22

 

[Bill Williamson]

ok I entered the 22 instead of the I+2 on the two lines shown above, still is not working, but after looking at it closer I am not sure those where the right lines for me to do it on... But I dont know.