Update existing row or add a new row if not found (Improvements needed)

J

jackie21

New Member
Joined
Jul 14, 2022
Messages
5
Office Version
  1. 365
Platform
  1. Windows
Hi- Still learning VBA...

I created a user form that links to the specific account that is being searched.
The user form is used to update or add the customer interactions/contact info ect... for that specific account.
The code I have below works...but it is extremely slow.
Any suggestions on how to improve the code would be very much appreciated.

Thank you


VBA Code: 
Private Sub UserForm_Initialize()

Dim account_number As String
account_number = Worksheets("SEARCH").Range("E11")
lastrow = Worksheets("Past_Communications").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To lastrow
If Worksheets("Past_Communications").Cells(i, 1).Value = account_number Then

Notes.Text = Worksheets("Past_Communications").Cells(i, 3).Value
CI.Text = Worksheets("Past_Communications").Cells(i, 4).Value
TS.Text = Worksheets("Past_Communications").Cells(i, 5).Value
SR.Text = Worksheets("Past_Communications").Cells(i, 6).Value


End If
Next

End Sub


Private Sub CommandButton1_Click()

Dim account_number As String
account_number = Worksheets("SEARCH").Range("E11")
lastrow = Worksheets("Past_Communications").Cells(Rows.Count, 1).End(xlUp).Row

Dim MIU As String
MIU = Worksheets("SEARCH").Range("E13")

Dim wsh As Worksheet
Set wsh = ThisWorkbook.Worksheets("Past_Communications")

Set tbl = wsh.ListObjects("Past_Comm")

Dim addRow As ListRow
Set addRow = tbl.ListRows.Add

For i = 2 To lastrow
If Worksheets("Past_Communications").Cells(i, 1).Value = account_number Then

Worksheets("Past_Communications").Cells(i, 3).Value = Notes.Text
Worksheets("Past_Communications").Cells(i, 4).Value = CI.Text
Worksheets("Past_Communications").Cells(i, 5).Value = TS.Text
Worksheets("Past_Communications").Cells(i, 6).Value = SR.Text


Else


With addRow

.Range(1) = account_number
.Range(2) = MIU
.Range(3) = Notes.Text
.Range(4) = CI.Text
.Range(5) = TS.Text
.Range(6) = SR.Text



End With
End If
Next

MsgBox "Saved", vbDefaultButton1, "Saved"


End Sub
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
Sort by date Sort by votes
Hi jackie21. Add an "Exit For" like this...
Code: 
SR.Text = Worksheets("Past_Communications").Cells(i, 6).Value
Exit For
HTH. Dave
 
Upvote 0
I might have totally missed the point here but see if the below helps.
Try it on a copy of your workbook.
Your code is adding an extra line to the table even if the account no is already there, I have assumed that is not correct.
I have also assumed that your account numbers are strings in your table, let me know if that is not the case.

VBA Code: 
Private Sub UserForm_Initialize()

Dim account_number As String
Dim lastrow As Long, acctRow As Long

account_number = Worksheets("SEARCH").Range("E11")
lastrow = Worksheets("Past_Communications").Cells(Rows.Count, 1).End(xlUp).Row

Dim wsh As Worksheet
Set wsh = ThisWorkbook.Worksheets("Past_Communications")

Dim tbl As ListObject
Set tbl = wsh.ListObjects("Past_Comm")

With Application
    acctRow = .IfError(.Match(account_number, tbl.ListColumns(1).Range, 0), 0)
End With

If acctRow <> 0 Then
    With tbl
        Notes.Text = .Range(acctRow, 3).Value
        CI.Text = .Range(acctRow, 4).Value
        TS.Text = .Range(acctRow, 5).Value
        SR.Text = .Range(acctRow, 6).Value
    End With
End If

End Sub

Private Sub CommandButton1_Click()

Dim account_number As String
Dim lastrow As Long, acctRow As Long

account_number = Worksheets("SEARCH").Range("E11")
lastrow = Worksheets("Past_Communications").Cells(Rows.Count, 1).End(xlUp).Row

Dim MIU As String
MIU = Worksheets("SEARCH").Range("E13")

Dim wsh As Worksheet
Set wsh = ThisWorkbook.Worksheets("Past_Communications")

Dim tbl As ListObject
Set tbl = wsh.ListObjects("Past_Comm")

With Application
    acctRow = .IfError(.Match(account_number, tbl.ListColumns(1).Range, 0), 0)
End With

If acctRow <> 0 Then
    With tbl
        .Range(acctRow, 3).Value = Notes.Text
        .Range(acctRow, 4).Value = CI.Text
        .Range(acctRow, 5).Value = TS.Text
        .Range(acctRow, 6).Value = SR.Text
    End With
Else
    Dim addRow As ListRow
    Set addRow = tbl.ListRows.Add
   
    With addRow
        .Range(1) = account_number
        .Range(2) = MIU
        .Range(3) = Notes.Text
        .Range(4) = CI.Text
        .Range(5) = TS.Text
        .Range(6) = SR.Text
    End With
End If

MsgBox "Saved", vbDefaultButton1, "Saved"

End Sub
 
Upvote 0
Solution
Alex Blakenburg said:
I might have totally missed the point here but see if the below helps.
Try it on a copy of your workbook.
Your code is adding an extra line to the table even if the account no is already there, I have assumed that is not correct.
I have also assumed that your account numbers are strings in your table, let me know if that is not the case.

VBA Code: 
Private Sub UserForm_Initialize()

Dim account_number As String
Dim lastrow As Long, acctRow As Long

account_number = Worksheets("SEARCH").Range("E11")
lastrow = Worksheets("Past_Communications").Cells(Rows.Count, 1).End(xlUp).Row

Dim wsh As Worksheet
Set wsh = ThisWorkbook.Worksheets("Past_Communications")

Dim tbl As ListObject
Set tbl = wsh.ListObjects("Past_Comm")

With Application
    acctRow = .IfError(.Match(account_number, tbl.ListColumns(1).Range, 0), 0)
End With

If acctRow <> 0 Then
    With tbl
        Notes.Text = .Range(acctRow, 3).Value
        CI.Text = .Range(acctRow, 4).Value
        TS.Text = .Range(acctRow, 5).Value
        SR.Text = .Range(acctRow, 6).Value
    End With
End If

End Sub

Private Sub CommandButton1_Click()

Dim account_number As String
Dim lastrow As Long, acctRow As Long

account_number = Worksheets("SEARCH").Range("E11")
lastrow = Worksheets("Past_Communications").Cells(Rows.Count, 1).End(xlUp).Row

Dim MIU As String
MIU = Worksheets("SEARCH").Range("E13")

Dim wsh As Worksheet
Set wsh = ThisWorkbook.Worksheets("Past_Communications")

Dim tbl As ListObject
Set tbl = wsh.ListObjects("Past_Comm")

With Application
    acctRow = .IfError(.Match(account_number, tbl.ListColumns(1).Range, 0), 0)
End With

If acctRow <> 0 Then
    With tbl
        .Range(acctRow, 3).Value = Notes.Text
        .Range(acctRow, 4).Value = CI.Text
        .Range(acctRow, 5).Value = TS.Text
        .Range(acctRow, 6).Value = SR.Text
    End With
Else
    Dim addRow As ListRow
    Set addRow = tbl.ListRows.Add
  
    With addRow
        .Range(1) = account_number
        .Range(2) = MIU
        .Range(3) = Notes.Text
        .Range(4) = CI.Text
        .Range(5) = TS.Text
        .Range(6) = SR.Text
    End With
End If

MsgBox "Saved", vbDefaultButton1, "Saved"

End Sub
Click to expand...
Hi Alex - Thank you for your reply!

I am still having trouble with the code. With your help I made adjustments and it is much much faster...but it is still adding an extra row even when the account number already exists. Any help on what I'm overlooking would be much appreciated.


VBA Code: 
Private Sub UserForm_Initialize()

Dim account_number As String
Dim lastrow As Long

account_number = Worksheets("SEARCH").Range("E11")
lastrow = Worksheets("Past_Communications").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To lastrow
If Worksheets("Past_Communications").Cells(i, 1).Value = account_number Then

Notes.Text = Worksheets("Past_Communications").Cells(i, 3).Value
CI.Text = Worksheets("Past_Communications").Cells(i, 4).Value
TS.Text = Worksheets("Past_Communications").Cells(i, 5).Value
SR.Text = Worksheets("Past_Communications").Cells(i, 6).Value


End If
Next

End Sub



Private Sub CommandButton1_Click()

Dim account_number As String
Dim lastrow As Long, acctRow As Long
Dim MIU As String

account_number = Worksheets("SEARCH").Range("E11")
lastrow = Worksheets("Past_Communications").Cells(Rows.Count, 1).End(xlUp).Row
MIU = Worksheets("SEARCH").Range("E13")

Dim wsh As Worksheet
Set wsh = ThisWorkbook.Worksheets("Past_Communications")

Dim tbl As ListObject
Set tbl = wsh.ListObjects("Past_Comm")

With Application
    acctRow = .IfError(.Match(account_number, tbl.ListColumns(1).Range, 0), 0)
End With

If acctRow <> 0 Then
With tbl
        .Range(acctRow, 3).Value = Notes.Text
        .Range(acctRow, 4).Value = CI.Text
        .Range(acctRow, 5).Value = TS.Text
        .Range(acctRow, 6).Value = SR.Text
    End With
Else
    Dim addRow As ListRow
    Set addRow = tbl.ListRows.Add
   
    With addRow
        .Range(1) = account_number
        .Range(2) = MIU
        .Range(3) = Notes.Text
        .Range(4) = CI.Text
        .Range(5) = TS.Text
        .Range(6) = SR.Text
    End With
End If

MsgBox "Saved", vbDefaultButton1, "Saved"

End Sub
 
Upvote 0
If you add "Val" as per the below, does that fix it ?

Rich (BB code): 
With Application
    acctRow = .IfError(.Match(Val(account_number), tbl.ListColumns(1).Range, 0), 0)
End With
 
Upvote 0
Alex Blakenburg said:
If you add "Val" as per the below, does that fix it ?

Rich (BB code): 
With Application
    acctRow = .IfError(.Match(Val(account_number), tbl.ListColumns(1).Range, 0), 0)
End With
Click to expand...
It sure did!!! Thank you so much. I appreciate the help!! :)
 
Upvote 0
You're welcome. Glad I could help.
The last adjustment was just catering for the Input Box being a Text value, while the actual list had account as a numeric value..
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question Question
Using pattern searches with a variable to find the correct values
2
Replies
10
Views
195
chazrab
C
K
  • Question Question
Copy row to another sheed based on drop-down list
Replies
6
Views
472
mumps
mumps
C
  • Solved
Need Help VBA
2
Replies
10
Views
427
Trebor76
T
M
  • Solved
cut/copy and paste row based on cell value not being equal to specific text
Replies
6
Views
494
mlan1604
M
J
  • Question Question
VBA Search box and button code
Replies
0
Views
247
jlcodes
J

Forum statistics

Threads
1,223,893
Messages
6,175,246
Members
452,623
Latest member
cliftonhandyman

Share this page

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