Overwrite data

Kmahraz · Aug 17, 2016

Hi-
I am looking for some assistance with my code below, the code work perfectly with one exception.
I have a Userform that I use to retrieve and update records, when I retrieve a record and make changes in my userform and press update I would like my code to update all rows associated with the same customer ID rather than updating only the first row for that specific customer in sheet 5 specifically.
please see image below:

PS: The columns I am targeting are
BCDE
JKLM
RSTU

Any help will be much appreciated!
-K-

Sample file :
https://www.dropbox.com/s/iqpdwbdi9l5t29x/xlstime.xlsm?dl=0

Code:

l= Sheet5.Cells(Rows.Count, "C").End(xlUp).Row
Set fnd = Sheet5.Range("A3:A" & l)
'Set rng = fnd.Find(What:=Me.ListBox1.List(i), LookIn:=xlFormulas) 'Grasor says 'i' not set to anything.For i = 0 To Me.ListBox1.ListCount - 1

If ListBox1.Selected(i) = TrueThen
Set rng = fnd.Find(What:=Me.ListBox1.List(i), LookIn:=xlFormulas)
EndIf
Next i

OnErrorResumeNext
c = rng.Row

If rng IsNothingThen
  MsgBox "No match found on Fittings Cost Data tab.", vbInformation
ExitSub
EndIf
With Me

'<~~ OVERRIDE DATA FOR WELDED FITTINGS~~~> rng.Offset(0, 1) = .cboWSSystem 
rng.Offset(0, 2) = .cboWUnit
rng.Offset(0, 3) = .cboWCurrency
rng.Offset(0, 4) = .cboWMaterial

'<~~ OVERRIDE DATA FOR THREADED FITTINGS~~~> rng.Offset(0, 9) = .cboTSSystem 
rng.Offset(0, 10) = .cboTUnit
rng.Offset(0, 11) = .cboTCurrency
rng.Offset(0, 12) = .cboTMaterial

'<~~ OVERRIDE DATA FOR SWAGELOK FITTINGS~~~> rng.Offset(0, 17) = .cboSSSystem 
rng.Offset(0, 18) = .cboSUnit
rng.Offset(0, 19) = .cboSCurrency
rng.Offset(0, 20) = .cboSMaterial

Marc L · Aug 17, 2016

Hi !

For other matching rows, use FindNext method as shown
in its VBA help like in Find method VBA help as well …

Kmahraz · Aug 18, 2016

Hi Marc,
I apology for my clumsy macro code. Please bear with this newbie.
Can you please elaborate ?

Thank you,
K

Marc L · Aug 18, 2016

First row is found with Find method and,
in case of several matching rows, use FindNext method.
Just follow sample of Find VBA inner help
or from many threads of this forum like
find text and selecting current region than copy paste to different sheet …

Kmahraz · Aug 18, 2016

Thank you @Marc L, I will give it a try and keep you posted.

Kmahraz · Aug 18, 2016

Hi,
For some-reason it's not working for me, is there a chance you can help update the code.

Thank you,
K

Luke M · Aug 18, 2016

Here's the full proceedure for the Update button, but the main change is just in the section you posted, about the Weldings. You can see how I used a Do...Until loop with the FindNext command.

Code:

Private Sub Update_Click()
   
    Dim c As Long
    Dim M As Long
    Dim l As Long
    Dim i As Variant
    Dim rng As Range
    Dim fnd As Range
    Dim firstAdd As String
   
    l = Sheet1.Cells(Rows.Count, "C").End(xlUp).Row
    M = Val(Me.ComboBox1.Value)
   
    ID = Me.ListBox1.Value
    If Me.ListBox1.ListIndex < 0 Then
        MsgBox "Pls select Cade ID"
        Exit Sub
    End If
   
    Set fnd = Sheet1.Range("M3:M" & l)
    'Set rng = fnd.Find(What:=Me.ListBox1.List(i), LookIn:=xlFormulas) ' 'i' not set to anything.
   
    'Grasor's Fix
    For i = 0 To Me.ListBox1.ListCount - 1
   
   
        If ListBox1.Selected(i) = True Then
            Set rng = fnd.Find(What:=Me.ListBox1.List(i), LookIn:=xlFormulas)
        End If
    Next i
   
    If rng Is Nothing Then
        MsgBox "No match found on Customer Info tab.", vbInformation
        Exit Sub
    End If
   
    c = rng.Row
       
    With Me
   
    'RETRIEVE DATA FROM SHEET 1 AND POPULATE TAB 1
        Sheet1.Cells(c, 2).Value = .txtFname.Value
        Sheet1.Cells(c, 3).Value = .txtCompany.Value
        Sheet1.Cells(c, 4).Value = .txtJobTitle.Value
        Sheet1.Cells(c, 5).Value = .txtEmail.Value
        Sheet1.Cells(c, 6).Value = .txtWebAdd.Value
        Sheet1.Cells(c, 7).Value = .txtbusiness.Value
        Sheet1.Cells(c, 8).Value = .txtMobile.Value
        Sheet1.Cells(c, 9).Value = .txtAddress.Value
        Sheet1.Cells(c, 11).Value = .txtSassociate.Value
        Sheet1.Cells(c, 12).Value = .txtNotes.Value
        Sheet1.Cells(c, 14).Value = .txtDate.Value
        '.txtCaseNumber.Value = Sheet1.Cells(c, 13).Value '<~~~~NOT NEEDED
       
    End With
   
    'RETRIEVE DATA FROM SHEET 5 AND POPULATE TAB 2
    l = Sheet5.Cells(Rows.Count, "C").End(xlUp).Row
   
    Set fnd = Sheet5.Range("A3:A" & l)
       
    For i = 0 To Me.ListBox1.ListCount - 1
        If ListBox1.Selected(i) = True Then
            Set rng = fnd.Find(What:=Me.ListBox1.List(i), LookIn:=xlFormulas)
            Exit For
        End If
    Next i
   
    If rng Is Nothing Then
        MsgBox "No match found on Fittings Cost Data tab.", vbInformation
        Exit Sub
    End If
   
   
    'Save this info for later
    firstAdd = rng.Address
   
    With Me
        Do
            c = rng.Row
           
            '<~~ OVERRIDE DATA FOR S1684 FITTINGS~~~>
             rng.Offset(0, 1) = .cboWSSystem
             rng.Offset(0, 2) = .cboWUnit
             rng.Offset(0, 3) = .cboWCurrency
             rng.Offset(0, 4) = .cboWMaterial
            '.CheckBox4 = False '<~~~~ NOT NEEDED, USER CAN CHOOSE TO CHECK THE BOX
           
            '<~~ OVERRIDE DATA FOR S1684 FITTINGS~~~>
            rng.Offset(0, 9) = .cboTSSystem
            rng.Offset(0, 10) = .cboTUnit
            rng.Offset(0, 11) = .cboTCurrency
            rng.Offset(0, 12) = .cboTMaterial
            '.CheckBox5 = False '<~~~~ NOT NEEDED, USER CAN CHOOSE TO CHECK THE BOX
           
           '<~~ OVERRIDE DATA FOR S1684 FITTINGS~~~>
            rng.Offset(0, 17) = .cboSSSystem
            rng.Offset(0, 18) = .cboSUnit
            rng.Offset(0, 19) = .cboSCurrency
            rng.Offset(0, 20) = .cboSMaterial
            '.CheckBox6 = False '<~~~~ NOT NEEDED, USER CAN CHOOSE TO CHECK THE BOX
           
            'Find next cell
            Set rng = fnd.FindNext(rng)
        Loop Until rng.Address = firstAdd
       
       
        'Loop through 10 rows to pull categories.
        'Assign Category 1 Items
        For i = 1 To 10
       
            rng.Offset(i - 1, 5) = .Controls.Item("cboCategory" & i) '<~~ OVERRIDE DATA FOR WELD FITTINGS
            rng.Offset(i - 1, 6) = .Controls.Item("TxtWPN" & i)
            rng.Offset(i - 1, 7) = .Controls.Item("TxtWC" & i)
            rng.Offset(i - 1, 8) = .Controls.Item("TxtWQ" & i)
           
            rng.Offset(i - 1, 14) = .Controls.Item("TxtTPN" & i) '<~~ OVERRIDE DATA FOR S1684 FITTINGS
            rng.Offset(i - 1, 15) = .Controls.Item("TxtTC" & i)
            rng.Offset(i - 1, 16) = .Controls.Item("TxtTQ" & i)
           
            rng.Offset(i - 1, 22) = .Controls.Item("TxtSPN" & i) '<~~ OVERRIDE DATA FOR S1684 FITTINGS
            rng.Offset(i - 1, 23) = .Controls.Item("TxtSC" & i)
            rng.Offset(i - 1, 24) = .Controls.Item("TxtSQ" & i)
           
        Next i
    End With
   
    l = Sheet2.Cells(Rows.Count, "C").End(xlUp).Row
    Set fnd = Sheet2.Range("A3:A" & l)
   
    For i = 0 To Me.ListBox1.ListCount - 1
   
        If ListBox1.Selected(i) = True Then
            Set rng = fnd.Find(What:=Me.ListBox1.List(i), LookIn:=xlFormulas)
        End If
    Next i
   
    If rng Is Nothing Then
        MsgBox "No match found on Fittings Cost Data tab.", vbInformation
        Exit Sub
    End If
   
    c = rng.Row
   
    With Me
   
            Sheet2.Cells(c, 2).Value = .TxtWS1.Value
            Sheet2.Cells(c, 3).Value = .TxtWS2.Value
            Sheet2.Cells(c, 4).Value = .TxtWS3.Value
            Sheet2.Cells(c, 5).Value = .TxtWS4.Value
            Sheet2.Cells(c, 6).Value = .TxtWS5.Value
            Sheet2.Cells(c, 7).Value = .TxtWS6.Value
            'Sheet2.Cells(c, 8).Value = .TxtWS7.Value
            Sheet2.Cells(c, 9).Value = .cboCPI.Value
            Sheet2.Cells(c, 10).Value = .TxtWS8.Value
            Sheet2.Cells(c, 11).Value = .TxtWS9.Value
            Sheet2.Cells(c, 12).Value = .TxtTS1.Value
            Sheet2.Cells(c, 13).Value = .TxtSS1.Value
            Sheet2.Cells(c, 14).Value = .TxtWS10.Value
            Sheet2.Cells(c, 15).Value = .TxtTS2.Value
            Sheet2.Cells(c, 16).Value = .TxtSS2.Value
            Sheet2.Cells(c, 17).Value = .TxtWS11.Value
            Sheet2.Cells(c, 18).Value = .TxtTS3.Value
            Sheet2.Cells(c, 19).Value = .TxtSS3.Value
            Sheet2.Cells(c, 20).Value = .TxtWS12.Value
            Sheet2.Cells(c, 21).Value = .TxtTS4.Value
            Sheet2.Cells(c, 22).Value = .TxtSS4.Value
            Sheet2.Cells(c, 23).Value = .TxtWS13.Value
            Sheet2.Cells(c, 24).Value = .TxtTS5.Value
            Sheet2.Cells(c, 25).Value = .TxtSS5.Value
            Sheet2.Cells(c, 26).Value = .TxtWS14.Value
            Sheet2.Cells(c, 27).Value = .TxtTS6.Value
            Sheet2.Cells(c, 28).Value = .TxtSS6.Value
            Sheet2.Cells(c, 29).Value = .TxtWS15.Value
            Sheet2.Cells(c, 30).Value = .TxtTS7.Value
            Sheet2.Cells(c, 31).Value = .TxtSS7.Value
            Sheet2.Cells(c, 32).Value = .TxtWS16.Value
            Sheet2.Cells(c, 33).Value = .TxtTS8.Value
            Sheet2.Cells(c, 34).Value = .TxtSS8.Value
            Sheet2.Cells(c, 35).Value = .TxtWS17.Value
            Sheet2.Cells(c, 36).Value = .TxtTS9.Value
            Sheet2.Cells(c, 37).Value = .TxtSS9.Value
            Sheet2.Cells(c, 38).Value = .TxtWS18.Value
            Sheet2.Cells(c, 39).Value = .TxtTS10.Value
            Sheet2.Cells(c, 40).Value = .TxtSS10.Value
            Sheet2.Cells(c, 41).Value = .TxtWS19.Value
            Sheet2.Cells(c, 42).Value = .TxtTS11.Value
            Sheet2.Cells(c, 43).Value = .TxtSS11.Value
            'Sheet2.Cells(c, 44).Value = .TxtOC1.Value '<~ Number of worker on the JOB
            Sheet2.Cells(c, 45).Value = .TxtOC2.Value
            Sheet2.Cells(c, 46).Value = .TxtOC3.Value
   
    End With
L0:

End Sub

Kmahraz · Aug 18, 2016

Thank you so much Luke, you help is much appreciated.

Regards,
-K-

Overwrite data

Kmahraz

Member

Marc L

Excel Ninja

Kmahraz

Member

Marc L

Excel Ninja

Kmahraz

Member

Kmahraz

Member

Luke M

Excel Ninja

Kmahraz

Member