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
 
It needs to go at the top of the module, before any code, as-per the code in your op.
 
Upvote 0

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
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
 
Upvote 0
You just need to move this line
VBA Code:
CheckBox1.Value = CBool(LCase(wsData1.Cells(RecordRow, 22).Value) = "yes")
Outside the loop
 
Upvote 0
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
 
Upvote 0
What error's do you get with the code as-is?
 
Upvote 0
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.
 
Upvote 0
But does that use the code in post#24?
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
Remove the +2 from the line that is causing the problem
 
Upvote 0

Forum statistics

Threads
1,213,551
Messages
6,114,268
Members
448,558
Latest member
aivin

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