VBA to avoid duplicates when inserting data, and to avoid different data being inserted for the same policy number

[Kc3475]

Hello there! I'm hoping you can help.

I'm having trouble figuring out how to capture data input by users into WB1 into a master workbook (WB2), without allowing multiple rows of data be input for the same policy number. I'd like it to instead override the existing data if it's for the same policy number.
I have code to insert the new row of data into the master workbook from the user's workbook. But I don't know how to avoid duplicates or multiple lines with different data for the same policy number.

Each user has a workbook on their desktop that they input data into, we'll call WB1
When they click on the Insert macro, it copies WB1, Sheet 6, Row 3, and inserts it at the bottom into WB2 Sheet 1.
One item they input is a policy number, which is in WB1, Sheet6, Range("C3").
I need to search column B in WB2 for this value.
If found, I need to copy WB1, Sheet6, Row 3, and paste it over the row with the matching number, in WB2, Sheet1.
If not found, I need to copy WB1, Sheet6, Row 3, and insert it under the last entry in WB2, Sheet1.

Also, instead of calling the user's WB1 "ThisWorkbook", I'd like to call it by the name, but it differs per user and is on their desktop. It always starts with the same word "Pfd" though. I thought using "Pfd*" would work, but it doesn't.

The code I have to insert the data is below. Any help would be greatly appreciated!

Sub Insert()

Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
          
    Workbooks.Open "network drive path for WB2"
    Set wsCopy = ThisWorkbook.Worksheets("Sheet6")        ' User's workbook WB1
    Set wsDest = Workbooks("Credit Spreadsheet.xlsx").Worksheets("Sheet1")     'Master workbook WB2
    IDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
    wsCopy.Range("3:3").Copy _
    wsDest.Range("A" & lDestLastRow)
    Workbooks("Credit Spreadsheet.xlsx").Close SaveChanges:=True

    End Sub

 

[Joe4]

Also, instead of calling the user's WB1 "ThisWorkbook", I'd like to call it by the name, but it differs per user and is on their desktop. It always starts with the same word "Pfd" though. I thought using "Pfd*" would work, but it doesn't.

Why? There is no need to. Using "ThisWorkbook" is more dynamic, and will work no matter what you name the file. And the VBA code will be found in this file anyway, right?

There shouldn't really be any reason why you need to capture the file name, but if you really want to, you could use a line like this:

fName as String
fName = ThisWorkbook.Name

Also, note the difference between "ThisWorkbook" and "ActiveWorkbook".

- "ThisWorkbook" will ALWAYS be the workbook this VB7A code is found in (the VBA code using the "ThisWorkbook" reference). So no matter how many files you have open, or what the active file is at the time, "ThisWorkbook" will never change (it is the the source of the VBA code).

- "ActiveWorkbook" is whatever the active workbook is when it hits that line of code. So if you open or select a different workbook, that workbook then becomes the "ActiveWorkbook".

One other thing, you should NEVER used reserved words like "Insert" as the names of your procedures, functions, or variables. Reserved words are words already used by Excel/VBA for names or methods, properties, functions, etc. Doing so can cause errors and unexpected results (as Excel may not be able to determine which one you are referring to - their built-in one or your created one). So I would change the name of your Procedure to something like "MyInsert" to differentiate it from Excel's built-in "Insert" method (Range.Insert method (Excel)).

Here is updates to your code which will search for a match, and overwrite it with the new row, or if there is no match, add a new row:

Sub MyInsert()

Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim policyNum As String
Dim lDestRow As Long
          
    'Workbooks.Open "network drive path for WB2"
    Set wsCopy = ThisWorkbook.Worksheets("Sheet6")        ' User's workbook WB1
    Set wsDest = Workbooks("Credit Spreadsheet.xlsx").Worksheets("Sheet1")     'Master workbook WB2

    'Capture policy number
    policyNum = wsCopy.Range("C3")
    
    'Search for policy number on destintation
    On Error GoTo err_chk
    wsDest.Activate
    lDestRow = Columns("C:C").Find(What:=policyNum, After:=Range("C1"), LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Row
    On Error GoTo 0
    
'   Copy to appropriate row
    wsCopy.Range("3:3").Copy _
    wsDest.Range("A" & lDestRow)
    Workbooks("Credit Spreadsheet.xlsx").Close SaveChanges:=True

    Exit Sub
    
    
err_chk:
    'If cannot find matching row, get the next available row
    If Err.Number = 91 Then
        Err.Clear
        lDestRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
        Resume Next
    Else
        MsgBox Err.Number & ":" & Err.Description
    End If

End Sub

 

[Kc3475]

Thank you so much, this works perfectly! And thank you for the explanation on ThisWorkbook vs ActiveWorkbook, makes perfect sense. You are the best!!!

 

[Joe4]

You are welcome.
Glad I was able to help!