Saving updated data record on current line vs saving new record

[Bill Williamson]

Hello,

Current userform has a save button, wich adds data to sheet 1, Added Search Button to find saved data for editing. If I use save button for Updated information it adds the information like new data at the bottom while old version still in the list. I added update button to use only when existing data is modified and I need it to save on the same row the original data was on, But I have a code issue. I am so new at this I cant see what the issue is..

I have Highlighted the line where I get the Run-Time Error '1004'
Application-Defined or Object-defined error

Private Sub Clearform()
'Sub Clearform()
  Dim ctrl As MSForms.Control
  For Each ctrl In Me.Controls
    Select Case TypeName(ctrl)
      Case "TextBox"
        ctrl.Text = ""
      Case "ComboBox"
        ctrl.ListIndex = -1
      Case "CheckBox"
        ctrl.Value = False
    End Select
  Next
End Sub


Private Sub ApperanceCheckBox_Click()
End Sub
Private Sub BRReviewCheckBox_Click()
End Sub
Private Sub BRReview_Click()
End Sub
Private Sub CancelButton_Click()
Unload Me


End Sub
Private Sub CommandButton1_Click()
    'Show User form
        UserForm1.Show


End Sub


Private Sub ClearButton_Click()


'Sub Clearform()
  Dim ctrl As MSForms.Control
  For Each ctrl In Me.Controls
    Select Case TypeName(ctrl)
      Case "TextBox"
        ctrl.Text = ""
      Case "ComboBox"
        ctrl.ListIndex = -1
      Case "CheckBox"
        ctrl.Value = False
    End Select
  Next
  
End Sub




Private Sub UserForm1_Click()
End Sub




Private Sub UserForm1_Initialize()




End Sub
    


Private Sub CMDSearch_Click()


Dim Fnd As Range
    
    With Sheets("Sheet1")
        If .AutoFilterMode Then .AutoFilterMode = False
        If Customer.Value <> "" Then .Range("A1").AutoFilter 1, Me.Customer.Value
        If CSONumber.Value <> "" Then .Range("A1").AutoFilter 2, Me.CSONumber.Value
        If JobNumber.Value <> "" Then .Range("A1").AutoFilter 3, Me.JobNumber.Value
        On Error Resume Next
        Set Fnd = .Range("A2:A" & Rows.Count).SpecialCells(xlVisible)(1)
        On Error GoTo 0
        If Fnd Is Nothing Then
        MsgBox "Search term not found"
    Else
        Customer.Text = Fnd.Value
        CSONumber.Text = Fnd.Offset(, 1).Value
        JobNumber.Text = Fnd.Offset(, 2).Value
        PCWeldType.Value = Fnd.Offset(, 3).Value
        PCWeldGrind.Value = Fnd.Offset(, 4).Value
        PCFinish.Value = Fnd.Offset(, 5).Value
        NonPCWeld.Value = Fnd.Offset(, 6).Value
        NonPCGrind.Value = Fnd.Offset(, 7).Value
        NonPCFinish.Value = Fnd.Offset(, 8).Value
        BRReview.Value = LCase(Fnd.Offset(, 9).Value) = "yes"
        BOMReview.Value = LCase(Fnd.Offset(, 10).Value) = "yes"
        DimReview.Value = LCase(Fnd.Offset(, 11).Value) = "yes"
        WeldReview.Value = LCase(Fnd.Offset(, 12).Value) = "yes"
        Apperance.Value = LCase(Fnd.Offset(, 13).Value) = "yes"
        Complete.Value = LCase(Fnd.Offset(, 14).Value) = "yes"
              
    End If
        'Turns off auto filter, shows all data
        .AutoFilterMode = False
        
    End With
End Sub



Private Sub CMDUpdate_Click()


Dim CurrentRow As Long
'Make Sheet1 Active
    Sheet1.Activate


'Update Records
Answer = MsgBox("Are you sure you want to update?", vbYesNo + vbQuestion, "Update Record")
    If Answer = vbYes Then
        Cells(CurrentRow, 1).Value = Customer.Value
        Cells(CurrentRow, 2).Value = CSONumber.Value
        Cells(CurrentRow, 3).Value = JobNumber.Value
        Cells(CurrentRow, 4).Value = PCWeldType.Value
        Cells(CurrentRow, 5).Value = PCWeldGrind.Value
        Cells(CurrentRow, 6).Value = PCFinish.Value
        Cells(CurrentRow, 7).Value = NonPCWeld.Value
        Cells(CurrentRow, 8).Value = NonPCGrind.Value
        Cells(CurrentRow, 9).Value = NonPCFinish.Value
    
        If BRReview.Value = True Then Cells(CurrentRow, 10).Value = "Yes"
        If BRReview.Value = False Then Cells(CurrentRow, 10).Value = "No"
        
        If BOMReview.Value = True Then Cells(CurrentRow, 11).Value = "Yes"
        If BOMReview.Value = False Then Cells(CurrentRow, 11).Value = "No"
        
        If DimReview.Value = True Then Cells(CurrentRow, 12).Value = "Yes"
        If DimReview.Value = False Then Cells(CurrentRow, 12).Value = "No"
        
        If WeldReview.Value = True Then Cells(CurrentRow, 13).Value = "Yes"
        If WeldReview.Value = False Then Cells(CurrentRow, 13).Value = "No"
          
        If Apperance.Value = True Then Cells(CurrentRow, 14).Value = "Yes"
        If Apperance.Value = False Then Cells(CurrentRow, 14).Value = "No"
         
        If Complete.Value = True Then Cells(CurrentRow, 15).Value = "Yes"
        If Complete.Value = False Then Cells(CurrentRow, 15).Value = "No"


End If








End Sub


Private Sub OKButton_Click()
Dim EmptyRow As Long
'Make Sheet1 Active
    Sheet1.Activate


'Determine Empty Row
EmptyRow = WorksheetFunction.CountA(Range("A:A")) + 1




'Transfer Information
Cells(EmptyRow, 1).Value = Customer.Value
Cells(EmptyRow, 2).Value = CSONumber.Value
Cells(EmptyRow, 3).Value = JobNumber.Value
Cells(EmptyRow, 4).Value = PCWeldType.Value
Cells(EmptyRow, 5).Value = PCWeldGrind.Value
Cells(EmptyRow, 6).Value = PCFinish.Value
Cells(EmptyRow, 7).Value = NonPCWeld.Value
Cells(EmptyRow, 8).Value = NonPCGrind.Value
Cells(EmptyRow, 9).Value = NonPCFinish.Value


If BRReview.Value = True Then Cells(EmptyRow, 10).Value = "Yes"
If BRReview.Value = False Then Cells(EmptyRow, 10).Value = "No"


If BOMReview.Value = True Then Cells(EmptyRow, 11).Value = "Yes"
If BOMReview.Value = False Then Cells(EmptyRow, 11).Value = "No"


If DimReview.Value = True Then Cells(EmptyRow, 12).Value = "Yes"
If DimReview.Value = False Then Cells(EmptyRow, 12).Value = "No"


If WeldReview.Value = True Then Cells(EmptyRow, 13).Value = "Yes"
If WeldReview.Value = False Then Cells(EmptyRow, 13).Value = "No"
  
If Apperance.Value = True Then Cells(EmptyRow, 14).Value = "Yes"
If Apperance.Value = False Then Cells(EmptyRow, 14).Value = "No"
 
If Complete.Value = True Then Cells(EmptyRow, 15).Value = "Yes"
If Complete.Value = False Then Cells(EmptyRow, 15).Value = "No"




'Sub Clearform()
  Dim ctrl As MSForms.Control
  For Each ctrl In Me.Controls
    Select Case TypeName(ctrl)
      Case "TextBox"
        ctrl.Text = ""
      Case "ComboBox"
        ctrl.ListIndex = -1
      Case "CheckBox"
        ctrl.Value = False
    End Select
  Next






End Sub




Private Sub UserForm_Click()


Call UserForm1_Initialize






End Sub

Any Help is appreciated
thank you


Bill Williamson

 

[dmt32]

Hi,
Codes for Add & Edit are almost identical so makes sense to use one code for both functions

Make backup of your workbook & replace all existing codes with following

Dim wsData As Worksheet
Dim Fnd As Range
Const xlUpdate As Integer = 2


Private Sub CMDSearch_Click()
    Dim i As Integer
    With wsData
        If .AutoFilterMode Then .AutoFilterMode = False
        If Customer.Value <> "" Then .Range("A1").AutoFilter 1, Me.Customer.Value
        If CSONumber.Value <> "" Then .Range("A1").AutoFilter 2, Me.CSONumber.Value
        If JobNumber.Value <> "" Then .Range("A1").AutoFilter 3, Me.JobNumber.Value
        On Error Resume Next
        Set Fnd = .Range("A2:A" & Rows.Count).SpecialCells(xlVisible)(1)
        On Error GoTo 0
        
        If Fnd Is Nothing Then
            MsgBox "Search term not found", 48, "Not Found"
            Me.CMDUpdate.Enabled = False
        Else
            
            For i = 1 To 15
                With Me.Controls(Choose(i, "Customer", "CSONumber", "JobNumber", _
                                            "PCWeldType", "PCWeldGrind", "PCFinish", _
                                            "NonPCWeld", "NonPCGrind", "NonPCFinish", _
                                            "BRReview", "BOMReview", "DimReview", _
                                            "WeldReview", "Apperance", "Complete"))
                    If i < 10 Then
                        .Text = Fnd.Offset(, i - 1).Value
                    Else
                        .Value = CBool(LCase(Fnd.Offset(, i - 1).Value) = "yes")
                    End If
                End With
            Next i
                
            Me.CMDUpdate.Enabled = True
            End If
'Turns off auto filter, shows all data
            .AutoFilterMode = False
            
        End With
End Sub


Private Sub CMDUpdate_Click()
   AddUpdateRecord Fnd.Row, xlUpdate
End Sub


Private Sub OKButton_Click()
    AddUpdateRecord WorksheetFunction.CountA(ws.Data.Range("A:A")) + 1, xlAdd
End Sub


Sub AddUpdateRecord(ByVal RecordRow As Long, ByVal Action As Integer)
    Dim i As Integer
    Dim Answer As VbMsgBoxResult
    
    If Action = xlUpdate Then
'Update Records
        Answer = MsgBox("Are you sure you want to update?", vbYesNo + vbQuestion, "Update Record")
        If Answer = vbNo Then Exit Sub
    End If
    
    With wsData
        For i = 1 To 9
            .Cells(RecordRow, i).Value = Choose(i, Customer.Value, CSONumber.Value, JobNumber.Value, _
                                                   PCWeldType.Value, PCWeldGrind.Value, PCFinish.Value, _
                                                   NonPCWeld.Value, NonPCGrind.Value, NonPCFinish.Value)
        Next i
    
            .Cells(RecordRow, 10).Value = IIf(BRReview.Value, "Yes", "No")
            .Cells(RecordRow, 11).Value = IIf(BOMReview.Value, "Yes", "No")
            .Cells(RecordRow, 12).Value = IIf(DimReview.Value, "Yes", "No")
            .Cells(RecordRow, 13).Value = IIf(WeldReview.Value, "Yes", "No")
            .Cells(RecordRow, 14).Value = IIf(Apperance.Value, "Yes", "No")
            .Cells(RecordRow, 15).Value = IIf(Complete.Value, "Yes", "No")
    End With
    msg = IIf(xlUpdate, "Updated", "Added")
    MsgBox "Record " & msg & " To Worksheet", 64, "Record " & msg
End Sub


Private Sub Clearform()
  Dim ctrl As MSForms.Control
  For Each ctrl In Me.Controls
    Select Case TypeName(ctrl)
      Case "TextBox"
        ctrl.Text = ""
      Case "ComboBox"
        ctrl.ListIndex = -1
      Case "CheckBox"
        ctrl.Value = False
    End Select
  Next
  Set Fnd = Nothing
  Me.CMDUpdate.Enabled = False
End Sub


Private Sub UserForm_Initialize()
    Set wsData = ThisWorkbook.Worksheets("Sheet1")
    Me.CMDUpdate.Enabled = False
End Sub

Note 1 - the variables at the top. These MUST sit at the very TOP of the forms code page OUTSIDE any procedure
2 in your posted code I noticed that you added a 1 at end of the UserForm_Initialize event - NEVER CHANGE any of the events names
this event is ALWAYS UserForm_Initialize regardless of your userforms name.


I have not been able to test any of my changes but hopefully it will compile & do what you want.

Dave

 

[dmt32]

Hi,
spotted some issues with code I posted earlier - let me know when ready to test & will post update

Dave

 

[Bill Williamson]

Sorry it has taken so long to get back to you, My primary responsibilities kept me swamped today. first time I have been able to look at it.
Deleated all code and replaced with new code. Corrected userform1 Opps, If add and update are the same, not sure I need both. as long as the ok button knows wether its an update or a new add. I Definatly have a few issues that can be addressed. I ran through it a few times looking for issues. Here is what I found so far.

Complete Checkbox no longer filling in all check Boxs.
OK Button No longer working.
Clear Button No longer working.
Cancel button No longer working.

When Clicking on Update Button ( It Works) but It pops up a message box, then after clicking, pops up a secong Msg Box.

I am new to the word of VBA have lots to learn.

Thanks for your assistance with this..


Bill Williamson

 

[Bill Williamson]

Sorry tried to edit this post but apparently there is a time limit to it.

on the 1st Item Complete Checkbox no longer filling in all check boxs I must have added that feture after posting my thread, I dont see it in my code.

This is the code I used for it, and it was working, but will it work with new code ( I dont want to screw thing up)

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

thoughts

 

[dmt32]

Sorry tried to edit this post but apparently there is a time limit to it.

on the 1st Item Complete Checkbox no longer filling in all check boxs I must have added that feture after posting my thread, I dont see it in my code.

This is the code I used for it, and it was working, but will it work with new code ( I dont want to screw thing up)


thoughts

Are you able to place copy of your workbook with some sample data in a dropbox & post a link to it here? This will remove the guess work & hopefully, can resolve issues.

Dave

 

[Bill Williamson]

How do I post a link to a file. ?Im pretty sure it has something to do with the Little word button with the sideways 8 but honestly have no clue what to type to link it. I do Email...

 

[dmt32]

How do I post a link to a file. ?Im pretty sure it has something to do with the Little word button with the sideways 8 but honestly have no clue what to type to link it. I do Email...

You cannot upload files directly on this site so need to use another sharing application. DropBox is most popular but there are others

you can open a personal account for free use

see if this helps

https://help.dropbox.com/guide/individual/how-to-use-dropbox#welcome-to-dropbox

Dave

 

[Bill Williamson]

here goes nothing,


https://www.dropbox.com/s/d7txg7x2x9z7pnl/BOM Review Setup2.xlsm?dl=0


see if that works...

 

[Bill Williamson]

I have been working on it a bit, the Complete Checkbox is working now,
Clear Button is working, Cancel Button is working.

only two issues remaining.
When Clicking update, getting two pop up Msg Boxs, really only need 1.
the Ok "Save" Button will not save new records, the Update Button only Updates but does not save New data, Willing to go to 1 Button "Save"? for both.