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
Thanks,
Bill Williamson
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 SubThanks,
Bill Williamson
