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

 

[Bill Williamson]

Thank you.

 

[Bill Williamson]

Good Morning,

This is currently the only open issue I have and only thread for it.

I thought the solution was found, but alas I still have a bug in the Save/Update.

If I do a Search, Modify a record then update, it saves the modifications to existing Data line. ( Works Well )

If I create a new record and "Add" it, it adds record to new line. ( working well )

I wanted to be able to do a search, modify a record and add the modified record as new, this did not function properly.

Tried work around, after search, and editing I did another search for the Modified result "Without Updating", when Search returned no result
I was able to add it as a new record to the last line.

The problem I am having is that, even though it adds it to the last line as if its a new record, the original document I edited " without Updating" is gone.

Any Ideas?

Best regards,

Bill Williamson

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




Private Sub CancelButton_Click()
    Unload Me
End Sub






Private Sub CBNext_Click()
Me.CBPrev.Enabled = True
  Dim lr As Long
  With wsData
    lr = .Range("A" & Rows.Count).End(xlUp).Row + 1
    For i = Fnd.Row + 1 To lr
      If i = lr Then
        MsgBox "Last row"
        Me.CBNext.Enabled = False
        Exit For
      End If
      If .Range("A" & i).EntireRow.Hidden = False Then
        If .Range("A" & i).Value <> "" Then
          Set Fnd = Range("A" & i)
        End If
        Exit For
      End If
    Next
  End With
  Call FillControls
End Sub






Private Sub CBPrev_Click()
  With wsData
    For i = Fnd.Row - 1 To 1 Step -1
      If i = 1 Then
        MsgBox "Fisrt row"
        Me.CBPrev.Enabled = False
        Exit For
      End If
      If .Range("A" & i).EntireRow.Hidden = False Then
        If .Range("A" & i).Value <> "" Then
          Set Fnd = Range("A" & i)
        End If
        Exit For
      End If
    Next
  End With
  Call FillControls
  Me.CBNext.Enabled = True
End Sub






Private Sub CMDSearch_Click()
Me.CMDAdd.Enabled = False
  Application.ScreenUpdating = False
      Dim i As Integer, n As Variant
        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)
        n = .Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Count
    On Error GoTo 0
        If n < 2 Then
            MsgBox "Search term not found", 48, "Not Found"
            Me.CMDUpdate.Enabled = False
            Me.CMDAdd.Enabled = True
           Else
              Call FillControls
                Me.CMDUpdate.Enabled = True
            Me.CBNext.Enabled = True
        End If
  End With
  Application.ScreenUpdating = True
End Sub






Sub FillControls()
  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
End Sub






Private Sub ClearButton_Click()
    Call ClearForm
End Sub






Private Sub CMDUpdate_Click()
   AddUpdateRecord Fnd.Row, xlUpdate
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
    
Call ClearForm


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 CMDAdd_Click()
Dim EmptyRow As Long
'Make Sheet1 Active
    Sheet1.Activate


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


'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"


MsgBox "Record Added"


'Sub Clearform()
Call ClearForm


End Sub




Private Sub ClearForm()
  'AutoFilterMode = False
   Set Fnd = Nothing
  Me.CMDUpdate.Enabled = False
  Me.CBNext.Enabled = False
  Me.CBPrev.Enabled = False
  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_Initialize()
    Set wsData = ThisWorkbook.Worksheets("Sheet1")
    Me.CMDUpdate.Enabled = False
    Customer.SetFocus
    Me.CBPrev.Enabled = False
    Me.CBNext.Enabled = False
End Sub

Thank you in advance for any help or ideas.

 

[dmt32]

Hi,
code you have just posted is a very early version of your project which has modified by another here.

I spent a period of time bringing your project up to a working standard but as is your choice - you opted for another's solution.
As this is not solution I posted & can only suggest you go back to contributor who assisted you with it

Dave