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

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)
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

T
  • Question
How to show Msg if Record not found in table
Replies
3
Views
87
myall_blues
myall_blues
M
  • Question
return multiple cell values based on multiple criteria
Replies
1
Views
491
mumps
mumps
I
  • Question
Current Code taking 10 Hours to run. Need Help to Optimize
Replies
5
Views
251
ItalianPlatinum
I
P
  • Solved
Type mis match & is there a quicker way?
Replies
4
Views
50
mumps
mumps
G
  • Solved
Add total row with a loop
Replies
4
Views
138
gberg
G

Forum statistics

Threads
1,214,792
Messages
6,121,612
Members
449,038
Latest member
apwr

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