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

B

Bill Williamson

Board Regular
Joined
Oct 7, 2019
Messages
124
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



VBA Code: 
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
 
Sort by date Sort by votes
Well if you don't know, I wouldn't have a clue, as I have no idea what you are trying to do, or what your userform is like. ;)
 
Upvote 0

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Sorry I am very new at this, just learning.
The userform consists of 9 text box's, these are now filling with data correctly when doing a search.
there is also a checkbox on the userform, it should get its value from column V


VBA Code:
VBA Code: 
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 9
        With Me.Controls(ControlsArr(i))
            If i < 10 Then
                If Action = xlGetRecord Then
                    .Text = wsData.Cells(RecordRow, i + 2).Value
                    .CheckBox = wsData.Cells(Recordrow,22).value    '************* Then Tried adding the checkbox here, did not work either...
                    
                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")    '*********  Tried 22 here
                Else
                     wsData.Cells(RecordRow, i+2).Value = IIf(.Value, "Yes", "No")   '******** and here, would not do search
                End If
            End If
        End With
    Next i
End Sub



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


Does it need to be in the Function Forms Control Section?
 
Upvote 0
As that isn't in the ControlsArr just use
VBA Code: 
CheckBox1.Value = CBool(LCase(wsData.Cells(RecordRow,22).Value) = "yes")
Outside the loop
 
Upvote 0
Unfortunately I lost all of my changes I made yesterday, and its back to not working, I dont know what happened.
Now when I try to run it I get a Compile error - User-Defined type error.
 
Upvote 0
Its Stopping on the following line,
"' Sub AddUpdateRecord(ByVal Action As XLRecordActionType) "


I comparing it to my original code to see if I screwed something up.





VBA Code: 
Private Sub UserForm_Click()

End Sub
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 Complete_Click()
'Dim oCtrl As Control
'For Each oControl In Me.Controls
'    If TypeOf oControl Is MSForms.CheckBox Then
'        oControl.Value = Complete.Value
'        End If
'        Next
'End Sub


Private Sub AddButton_Click()
    AddUpdateRecord xlAddRecord
End Sub


Private Sub ClearButton_Click()
    ClearForm
End Sub


Private Sub CBPrevious_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
    
    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
        
    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


'**************************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.CBPrevious.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)    ' @@@@@@@@@this is where its stopping@@@@@@@@
        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 = ""
      'Case "ComboBox"
      '  ctrl.ListIndex = -1
      'Case "CheckBox"
       ' ctrl.Value = False
    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("C:C+2"))
    
    For i = 1 To 9
        With Me.Controls(ControlsArr(i))
            If i < 10 Then
                If Action = xlGetRecord Then
                    .Text = wsData.Cells(RecordRow, i + 2).Value
                Else
                    wsData.Cells(RecordRow, 2).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", _
                        "Part Name", "Part#", "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


Private Sub UserForm_Initialize()
    Dim wsFormData As Worksheet
    Dim ControlsArr As Variant
    Dim c As Integer, i As Integer
    
    ControlsArr = FormControls
    
    With ThisWorkbook
       Set wsData = .Worksheets("Data")
       'Set wsFormData = .Worksheets("Form Data")
    End With
    
'populate comboboxes
'     For i = 4 To 9
'        c = c + 1
'        With Me.Controls(ControlsArr(i))
'            .RowSource = ""
'           .List = wsFormData.Cells(2, c).Resize(wsFormData.Cells(wsFormData.Rows.Count, c).End(xlUp).Row - 1).Value
'        End With
'    Next i
'button status
    Me.CMDUpdate.Enabled = False
    Me.AddButton.Enabled = False
    ButtonsEnable
    EnableNavigationButtons xlFirst
    wsData.AutoFilterMode = False
    Me.Customer.SetFocus
End Sub
 
Upvote 0
Do you still have this at the top of the module
VBA Code: 
Enum XLRecordActionType
    xlUpdateRecord = 1
    xlAddRecord = 2
    xlGetRecord = 3

End Enum
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question Question
VBA UserForm Search and Update Me.Controls Issue
Replies
4
Views
1K
Kyle123
Kyle123
B
  • Question Question
Help understanding an expression or sub.
2
Replies
11
Views
858
DanteAmor
DanteAmor
B
  • Question Question
Setting up Previous and next Buttons for search results
2
Replies
14
Views
4K
DanteAmor
DanteAmor
L
  • Question Question
"Object variable or With block variable not set" but it is, help
2
Replies
14
Views
4K
jasonb75
J
P
  • Question Question
Runtime error 91 Object Variable or with block variable not set
2
Replies
16
Views
3K
Fluff
Fluff

Forum statistics

Threads
1,223,911
Messages
6,175,337
Members
452,637
Latest member
Ezio2866

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top