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

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
 

Bill Williamson

Board Regular
Joined
Oct 7, 2019
Messages
124
That took care of the error and it is adding the record, but it is saving over the last row, not adding a new row.
 

Some videos you may like

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,448
Office Version
  1. 365
Platform
  1. Windows
Then just add 1 to the variable.
 

Bill Williamson

Board Regular
Joined
Oct 7, 2019
Messages
124
I thought you meant here, but it does not like how I tried adding it. says expected end of statement

VBA Code:
If Action = xlAddRecord Then RecordRow = WorksheetFunction.CountA+1(wsData1.Range("C:C"))
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,448
Office Version
  1. 365
Platform
  1. Windows
It needs to go at the very end of that line.
 

Bill Williamson

Board Regular
Joined
Oct 7, 2019
Messages
124

ADVERTISEMENT

Good Morning Fluff,

Sorry it has taken so long to get back. You asked questions I was not sure the answer to.
So needing to learn, i have been trying to do some research and tinkering with the code.
I found multiple problems with the subs for Adding, Getting and Updating records.
I Think I have all of those issues worked out, many with the help you provided earlier in this thread.

I can do a search and "GetRecord", it properly sorts the data, fills the userform and I can scroll through the records with the Next and Prev.
I can "UpdateRecord" and it makes the changes to the WorkSheet.
I can "AddRecord" and its putting the Information from Userform to the worksheet in the last row.

The only issue i am aware of is still the stupid check box......
You suggested I move the code below outside the loop, Previous Messages 24-28
VBA Code:
CheckBox1.Value = CBool(LCase(wsData1.Cells(RecordRow, 22).Value) = "yes")


But I am still not quite sure where to put it.
But now I do know now that the sub that is mentioned in #24 is the section that is supposed to handle the check box.

The checkbox function is trying to work with current changes.

If I add or update a record with it checked or unchecked and do a search for it again the check mark status is correct when I scroll
through the parts.
But
I honestly do not know how this part is working since the Yes/No Data in column V does not change to match checkbox status
I dont know where it is storing the information, but i dont see any other on the worksheet.
It can say no but check box is checked or say yes and be unchecked.

Not sure how to proceed. I have attached Current rev. and hope you have an Idea.




Code:
Sub AddGetRecord(ByVal Action As XLRecordActionType)
    Dim i As Integer
    Dim ControlsArr As Variant
    
    ControlsArr = FormControls
    
 ' original Code
 ' If Action = xlAddRecord Then RecordRow = WorksheetFunction.CountA(wsData1.Range("A:A"))
 '   Modified to move Data two columns to right on New Worksheet
 ' Added a (1) to get last row +1 and Changed range from A:A to C:C
    If Action = xlAddRecord Then RecordRow = WorksheetFunction.CountA(wsData1.Range("C:C")) + 1
    
    'Original Code For i = 1 To 15    ' Original Form Had total of 15 form controls 9 Text 6 check boxs
    ' Changed to 10 total controls  ***** Check Box is in Column V Not with other data columns *****
    
    For i = 1 To 10
        With Me.Controls(ControlsArr(i))
        
            
            If i < 10 Then
                If Action = xlGetRecord Then
                
                ' original code   Modifications made, seems to be working correct.
                  ' .Text = wsData1.Cells(RecordRow, i).Value
                    .Text = wsData1.Cells(RecordRow, i + 2).Value ' Added +2 to get correct column
                
                Else
                '   wsData1.Cells(RecordRow, i).Value = .Value     Original code
                    wsData1.Cells(RecordRow, i + 2).Value = .Value ' Added +2 to get correct column
                End If
            Else
                If Action = xlGetRecord Then
     '.Value = CBool(LCase(wsData1.Cells(RecordRow, i).Value) = "yes")   'Original code
    
     CheckBox1.Value = CBool(LCase(wsData1.Cells(RecordRow, i + 22).Value) = "yes")
     '******    When using this the Check Box is almost working ************
                  
                Else
                    'wsData1.Cells(RecordRow, i).Value = IIf(.Value, "Yes", "No")  'Original Code
                    
                    wsData1.Cells(RecordRow, i + 22).Value = IIf(.Value, "Yes", "No")
            
                End If
            End If
        End With
    Next i

 
End Sub



Function FormControls() As Variant

'FormControls = Array("Customer", "CSONumber", "JobNumber", _      ******* Original Code ********
                    '    "PCWeldType", "PCWeldGrind", "PCFinish", _
                    '    "NonPCWeld", "NonPCGrind", "NonPCFinish", _
                    '    "BRReview", "BOMReview", "DimReview", _
                    '    "WeldReview", "Apperance", "Complete")




FormControls = Array("Customer", "CSONumber", "JobNumber", _
                        "PartName", "PartNumber", "Quantity", "Tacker", "Welder", "IssuesFound", "CheckBox1")
                        
End Function


I think its close

Thanks for all your help,
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,448
Office Version
  1. 365
Platform
  1. Windows
I honestly do not know how this part is working since the Yes/No Data in column V does not change to match checkbox status
It's not changing the value in col V, it's changing the checkbox to match what is already in col V
 

Bill Williamson

Board Regular
Joined
Oct 7, 2019
Messages
124
Fluff,

I really thought that it is supposed to do both depending on action
Im trying to visualize how this works, while explaining what its doing compared to what I need.
I am so new i feel like I peeling an Onion........with the layers

The way It is set up, when userform is opened, it has no Data,
If it is filled out and the Addrecord button hit, it .....starts the top layer....

VBA Code:
Private Sub AddButton_Click()
    AddUpdateRecord xlAddRecord
End Sub

Which Opens the AddUpdateRecord sub
Code:
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, wsData1, 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



I think this Basically checks to see if the record already exists, then calls the AddGetRecord

This looks like it does all the work back and forth between worksheet and userform......
The getting, adding and the updating

It has the Addrecord portion which should add the record to the Worksheet and put a yes or no in column V, Based on value of the checkbox

The getrecord portion which is used in the search as well, this should fill the userform and the checkbox should match the record, Checked if yes.
otherwise unchecked if no

After I get a record from a search, I can change it, If Previously checked and I change it then Hit Update.
The yes/no from Column V should change to match the current state of the Button.

Here is what is Happening

The search, add and update all seems to be working except the checkbox status and the Data in column V that should be correlated

The way it is currently working when adding or updating a record is, it puts a no in column V regardless of the check box status but if checked the
check box stays marked for that part when saved or updated. How this is working without column V , No clue.
And if you change the no to a yes in column V it does not change the checkbox status



Im pretty certain part of the issue is that the form this code was originally written for had all data next to each other.....
and now the checkbox data is separated from the rest Also it originally had 6 check boxs now 1,
so I may have easily missed something when modifying.


Code:
Sub AddGetRecord(ByVal Action As XLRecordActionType)
    Dim i As Integer
    Dim ControlsArr As Variant
    
    ControlsArr = FormControls
    
 ' original Code
 ' If Action = xlAddRecord Then RecordRow = WorksheetFunction.CountA(wsData1.Range("A:A"))

 '   Modified to move Data two columns to right on New Worksheet
 ' Added a (1) to get last row +1 and Changed range from A:A to C:C



    If Action = xlAddRecord Then RecordRow = WorksheetFunction.CountA(wsData1.Range("C:C")) + 1
    



    'Original Code For i = 1 To 15    ' Original Form Had total of 15 form controls 9 Text 6 check boxs
    ' Changed to 10 total controls  ***** Check Box data is in Column V Not with other data columns *****
    
    For i = 1 To 10
        With Me.Controls(ControlsArr(i))
        
            
            If i < 10 Then
                If Action = xlGetRecord Then
                
                ' original code   Modifications made, seems to be working correct.
                  ' .Text = wsData1.Cells(RecordRow, i).Value
                    .Text = wsData1.Cells(RecordRow, i + 2).Value ' Added +2 to get correct column
                
                Else
                '   wsData1.Cells(RecordRow, i).Value = .Value     Original code
                    wsData1.Cells(RecordRow, i + 2).Value = .Value ' Added +2 to get correct column
                End If
            Else
                If Action = xlGetRecord Then
     '.Value = CBool(LCase(wsData1.Cells(RecordRow, i).Value) = "yes")   'Original code
    
     CheckBox1.Value = CBool(LCase(wsData1.Cells(RecordRow, i + 22).Value) = "yes")
     '******    When using this the Check Box is almost working ************
                  
                Else
                    'wsData1.Cells(RecordRow, i).Value = IIf(.Value, "Yes", "No")  'Original Code
                    
                    wsData1.Cells(RecordRow, i + 22).Value = IIf(.Value, "Yes", "No")
            
                End If
            End If
        End With
    Next i

 
End Sub

I included, but commented out a lot of the original Code. Hoping to possibly help with debugging it. but not with me bugging you..lol
Sorry this was so long winded,

Any help is greatly appreciated


Thanks,


Bill
 

Watch MrExcel Video

Forum statistics

Threads
1,114,542
Messages
5,548,637
Members
410,862
Latest member
uskudar
Top