excelvba

Why is my macro writing duplicate values when it should be skipping those values?


At work I'm consolidating several Excel sheets into one, but only want to merge new values into a master sheet. Currently my code does work and will properly add new values, but after a couple minutes it will start adding duplicate values. The code takes the value of a cell from Sheet 2, uses the Find function to see if it exists on Sheet 1, and if not it will add the new data onto Sheet 1. I know this isn't pretty and there's likely a better way to do this (Such as putting the contents of Sheet 2 into an array since it's static), but here's what I've got so far.

Sample table (Note, actual row count on each sheet is about 250k-300k):

NDC Daily Average Drug Name and Strength
72143025430 1.263 ACCUTANE CAP 40MG
70010016101 5.652 ACETAMINOPHN TAB 500MG
16571010601 1.000 AMITRIPTYLIN TAB 25MG
Sub DoTheThing()

    'This sub is ran from Sheet 2
    Application.ScreenUpdating = False

    Dim rowZ As Long, NDC As String, Avg As String, drugName As String, newCounter As Long

    rowZ = Range("A1").CurrentRegion.Rows.Count
    newCounter = 0

    For i = 2 To rowZ 'Start at 2 to ignore table headers
        NDC = Cells(i, 1)
        Avg = Cells(i, 2)
        drugName = Cells(i, 3)
        If Does_NDC_Exist(NDC, Avg, drugName) Then
            'Debug.Print "NDC does exist"
        Else
            'Debug.Print Cells(i, 3) & NDC & " does not exist"
            newCounter = newCounter + 1
        End If

    Next i

    Debug.Print "Added " & newCounter & " to Compiled list"

    Application.ScreenUpdating = True

End Sub

Function Does_NDC_Exist(NDC As String, Avg As String, drugName As String) As Boolean

    Dim rngAddress As Range
    Set rngAddress = Worksheets(1).Range("A:A").Find(NDC, LookIn:=xlValues, LookAt:=xlWhole)
    
    If rngAddress Is Nothing Then
        Does_NDC_Exist = False
        'Call ddFunctions.StoreData(NDC)
        Call AddNewNDC(NDC, Avg, drugName)
    Else
        Does_NDC_Exist = True
    End If

End Function

Function AddNewNDC(NDC As String, Avg As String, drugName As String)

    Dim rowZ As Long
    rowZ = Worksheets(1).Range("A1").CurrentRegion.Rows.Count
    Cells(rowZ + 1, 1).Select
    Worksheets(1).Cells(rowZ + 1, 1).Value = NDC
    Worksheets(1).Cells(rowZ + 1, 2).Value = Avg
    Worksheets(1).Cells(rowZ + 1, 3).Value = drugName

End Function

I've been working on this for a couple weeks now (I'm pretty new to all of this still, and am slowly learning). When I step into the code and do it slowly/manually review each line, I don't seem to get duplicate values put into Sheet 1. Maybe there's a problem going back and forth so quick between sheets? I'm at a bit of a loss here.


Solution

  • This fits better in a single Sub I think. When searching for an exact value, Match is typically faster than Find.

    FYI you're using NDC As String, so you should make sure all of the values in Column A where you're trying to find a match are stored as Text, not as Numbers.

    Sub DoTheThing()
    
        Dim NDC As String, Avg As String, drugName As String, newCounter As Long
        Dim wsSrc As Worksheet, wsDest As Worksheet, i As Long, m
        
        Application.ScreenUpdating = False
    
        Set wsSrc = ThisWorkbook.Worksheets("Source") 'for example
        Set wsDest = ThisWorkbook.Worksheets("Data")
    
        For i = 2 To wsSrc.Cells(Rows.Count, "A").End(xlUp).Row 'Start at 2 to ignore table headers
            NDC = wsSrc.Cells(i, 1).Value
            Avg = wsSrc.Cells(i, 2).Value
            drugName = wsSrc.Cells(i, 3).Value
            
            m = Application.Match(NDC, wsDest.Columns(1), 0) 'any match ?
            If IsError(m) Then                               'no match? : use next empty row
                With wsDest.Cells(Rows.Count, "A").End(xlUp).Offset(1)
                    .NumberFormat = "@" 'text
                    .Resize(1, 3).Value = Array(NDC, Avg, drugName) 'add values
                End With
                newCounter = newCounter + 1
            End If
            
        Next i
    
        Debug.Print "Added " & newCounter & " to Compiled list"
    
        Application.ScreenUpdating = True
    
    End Sub