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
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,448
Office Version
  1. 365
Platform
  1. Windows
It needs to go at the top of the module, before any code, as-per the code in your op.
 

Some videos you may like

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes

Bill Williamson

Board Regular
Joined
Oct 7, 2019
Messages
124
OK I finally got everything working again except the checkbox, at least to where it was was a couple days ago.
so not sure if I should continue with this thread or Start a new one Since it is no longer a Object variable or block variable problem.
Please advise on this.

If we are going to continue here, this is where I am...

When I do a "search", By any combination of these three Items ,customer, CSO # or Job # and if it finds a match it fills the form in with the remainder of the matching data, Including part number, description, who Tacked it together, welded and what if any defects were found in the part.
This part seems to be working correctly.

Only Known issue at this point is the check box.

If I do a search and a record is found "checkbox1 on userform should match the record, checked if a yes, unchecked if a no in column V. I am able to use the next and prev buttons to move through however many rows of parts that job has, not all parts will have issues so would depend on that particular rows information.

After a search and if a match was found, I can change information then "update" it. If the status of checkbox was changed and the "update" button used,
it should then change column V to a yes or no to match checkbox.


But I also use the userform to "add records", It finds the last row and adds any portion of the user form that is filled out. ( I have not tested this portion yet with the changes I have made to it. the only issue I foresee will be the same checkbox , it should change column V to a yes or no to match checkbox.


You gave me this code to try to fix this, But then I had the problems....but Finally back to this part.

Here is my code.

VBA Code:
Option Base 1
Dim wsData1 As Worksheet
Dim RecordRow As Long
Dim Fnd As Range
Dim FilterCount As Long

Enum XLRecordActionType
    xlUpdateRecord = 1
    xlAddRecord = 2
    xlGetRecord = 3
End Enum




Private Sub CheckBox1_Click()

End Sub

'**************************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()

    wsData.AutoFilterMode = False
    ClearForm
End Sub


Private Sub CBPrev_Click()
    Set Fnd = wsData1.Columns(3).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 = wsData1.Columns(3).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()
    wsData1.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 wsData1.AutoFilterMode Then wsData1.AutoFilterMode = False
    
    For i = 1 To 3
        With Me.Controls(ControlsArr(i))
            If Len(.Text) > 0 Then wsData1.Range("A1").AutoFilter i + 2, .Text
        End With
    Next i
        
    On Error Resume Next
        Set Fnd = wsData1.Range("C2:C" & wsData1.Rows.Count).SpecialCells(xlVisible)(1)
        Set FilterRange = wsData1.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
       ' WSData1.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.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, 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



Private Sub ClearForm()
  Dim ctrl As MSForms.Control
  For Each ctrl In Me.Controls
    Select Case TypeName(ctrl)
      Case "TextBox"
        ctrl.Text = ""
    
      Case "CheckBox1"
       ctrl.Value = False
    End Select
  Next
  Me.CMDUpdate.Enabled = False
  Me.AddButton.Enabled = False
  FilterCount = 0
  EnableNavigationButtons xlFirst
  Me.Customer.SetFocus
  wsData1.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(wsData1.Range("C:C+2"))
    
    For i = 1 To 9
        With Me.Controls(ControlsArr(i))
            If i < 10 Then
                If Action = xlGetRecord Then
                    .Text = wsData1.Cells(RecordRow, i + 2).Value
                    
            'Fills Checkbox1 with data
                    'CheckBox1.Value = CBool(LCase(wsData1.Cells(RecordRow, 22).Value) = "yes")
                
                Else
                    wsData1.Cells(RecordRow, 2).Value = .Value
                End If
            Else
                If Action = xlGetRecord Then
                    CheckBox1.Value = CBool(LCase(wsData1.Cells(RecordRow, i).Value) = "yes")
                Else
                    'wsData1.Cells(RecordRow, 22).Value = IIf(.Value, "Yes", "No")
                   wsData1.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", _
                        "PartName", "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


Private Sub PartNumber_Change()

End Sub

Private Sub UserForm_Initialize()

    
    ControlsArr = FormControls
    
    With ThisWorkbook
       Set wsData1 = .Worksheets("Data")
      
    End With
    

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

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,448
Office Version
  1. 365
Platform
  1. Windows
You just need to move this line
VBA Code:
CheckBox1.Value = CBool(LCase(wsData1.Cells(RecordRow, 22).Value) = "yes")
Outside the loop
 

Bill Williamson

Board Regular
Joined
Oct 7, 2019
Messages
124
Im not 100 % certain about where you mean when you say outside loop....

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(wsData1.Range("C:C+2"))
    
    For i = 1 To 9
        With Me.Controls(ControlsArr(i))
            If i < 10 Then
                If Action = xlGetRecord Then
                    .Text = wsData1.Cells(RecordRow, i + 2).Value
                    
            'Fills Checkbox1 with data
                    'CheckBox1.Value = CBool(LCase(wsData1.Cells(RecordRow, 22).Value) = "yes")  ' @@@@@@Tried it here.......no luck
                
                Else
                    wsData1.Cells(RecordRow, 2).Value = .Value
                End If
            Else
                If Action = xlGetRecord Then
                    CheckBox1.Value = CBool(LCase(wsData1.Cells(RecordRow, i).Value) = "yes")  ' Modified
                Else
                    'wsData1.Cells(RecordRow, 22).Value = IIf(.Value, "Yes", "No")       ' This is what I changed it too to to try to get column  V
                   wsData1.Cells(RecordRow, i).Value = IIf(.Value, "Yes", "No")            ' this was original code @@@@@@@
                End If
            End If
        End With
    Next i

' I think this is where you want it........?????????

End Sub



There are a few lines that mention the checkbox, or the location of that column so Im sorry but I am not sure. do I remove the other lines that mention them. or just add the new code?



Thanks,

Bill
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,448
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

What error's do you get with the code as-is?
 

Bill Williamson

Board Regular
Joined
Oct 7, 2019
Messages
124
As of right now I am only working on the search function, when doing a search I get no errors, Its is properly filling all Text box's on the userform with the information from the search, except for checkbox1.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,448
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

But does that use the code in post#24?
 

Bill Williamson

Board Regular
Joined
Oct 7, 2019
Messages
124
Here is the most recent code with some updates I have been trying with some success.

I included a lot of the original code to maybe help trouble shoot the errors I made in my modifications.

I believe all of the issues I am having are with this sub routine, and the ranges of data.... But I don't know for sure.....

The Search and the get record portion seems to be working with the modifications made, with the exception of the check box, it should be getting its Value from Column "V" If column V is Yes then check box should be marked, if not then no.

The Update record Was storing data in the wrong columns, but I modified code and now seems to be working With the exception of check box, It should store Value in column V


The Add record function is not working, I get a :
Run-Time Error 1004
Method range of object_'WorkSheet' Failed




VBA 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
 
    If Action = xlAddRecord Then RecordRow = WorksheetFunction.CountA(wsData1.Range("C:C+2")) 'Stops Here When trying to Add record
    
    'Original Code For i = 1 To 15    ' Original Form Had total of 15 form controls
    ' Changed to 9 because new form only has 9  ***** Check Box is in Column V  *****
    
    For i = 1 To 9
        With Me.Controls(ControlsArr(i))
            If i < 10 Then
                If Action = xlGetRecord Then
                
                ' original code   Modifications made, not sure if correct.
                
                  ' .Text = wsData1.Cells(RecordRow, i).Value
               
                    .Text = wsData1.Cells(RecordRow, i + 2).Value
                 
                Else
                '   wsData1.Cells(RecordRow, i).Value = .Value     *********************Original code
                    wsData1.Cells(RecordRow, i + 2).Value = .Value
                End If
            Else
                If Action = xlGetRecord Then
                
                '.Value = CBool(LCase(wsData1.Cells(RecordRow, i).Value) = "yes")   ****************Original code
                
                    .Value = CBool(LCase(wsData1.Cells(RecordRow, i + 22).Value) = "yes")
                    
                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

Thanks again for all your help.

Bill Williamson
 

Bill Williamson

Board Regular
Joined
Oct 7, 2019
Messages
124
I just realized there is a separate Sub " AddUpdate record that could be part of the problem as well so I am just going to include the whole thing for reference.

VBA Code:
Option Base 1
Dim wsData1 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()

    'wsData1.AutoFilterMode = False
    If wsData1.AutoFilterMode Then wsData1.AutoFilterMode = False
    FilterCount = 0
    ClearForm
End Sub


Private Sub CBPrev_Click()
    Set Fnd = wsData1.Columns(3).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 = wsData1.Columns(3).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()
    'wsData1.AutoFilterMode = False
    'If wsData1.AutoFilterMode Then wsData1.AutoFilterMode = False
    wsData1.AutoFilter.ShowAllData
    Unload Me
End Sub


    Private Sub CMDSearch_Click()
    Dim i As Integer
    Dim ControlsArr As Variant
    Dim FilterRange As Range
    
    ControlsArr = FormControls
    
    If wsData1.AutoFilterMode Then wsData1.AutoFilterMode = False
    
    For i = 1 To 3
        With Me.Controls(ControlsArr(i))
            If Len(.Text) > 0 Then wsData1.Range("A1").AutoFilter i + 2, .Text
        End With
    Next i
        
    On Error Resume Next
        Set Fnd = wsData1.Range("C2:C" & wsData1.Rows.Count).SpecialCells(xlVisible)(1)
        Set FilterRange = wsData1.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
       ' WSData1.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.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, 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



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



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
 
    If Action = xlAddRecord Then RecordRow = WorksheetFunction.CountA(wsData1.Range("C:C+2")) 'Stops Here When trying to Add record
    
    'Original Code For i = 1 To 15    ' Original Form Had total of 15 form controls
    ' Changed to 9 because new form only has 9  ***** Check Box is in Column V  *****
    
    For i = 1 To 9
        With Me.Controls(ControlsArr(i))
            If i < 10 Then
                If Action = xlGetRecord Then
                
                ' original code   Modifications made, not sure if correct.
                
                  ' .Text = wsData1.Cells(RecordRow, i).Value
               
                    .Text = wsData1.Cells(RecordRow, i + 2).Value
                 
                Else
                '   wsData1.Cells(RecordRow, i).Value = .Value     Original code
                    wsData1.Cells(RecordRow, i + 2).Value = .Value
                End If
            Else
                If Action = xlGetRecord Then
                
                '.Value = CBool(LCase(wsData1.Cells(RecordRow, i).Value) = "yes")   Original code
                
                    .Value = CBool(LCase(wsData1.Cells(RecordRow, i + 22).Value) = "yes")
                    
                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



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 PartNumber_Change()

End Sub

Private Sub UserForm_Initialize()
Dim ControlsArr As Variant
    
    ControlsArr = FormControls
    
    With ThisWorkbook
       Set wsData1 = .Worksheets("Data")
       
    End With
  '  populate comboboxes    **********    Removed no longer have combo Box's ************
     '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
    wsData1.AutoFilterMode = False
    Me.Customer.SetFocus
End Sub


If you have any questions about the old userform or the new one.... or anything just ask...
I appreciate your help so much.

Thanks,

Bill
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,448
Office Version
  1. 365
Platform
  1. Windows
Remove the +2 from the line that is causing the problem
 

Watch MrExcel Video

Forum statistics

Threads
1,114,542
Messages
5,548,635
Members
410,861
Latest member
Victor96
Top