Vlookup all blank cells taking a long time..

[SkywardPalm]

I'm attempting to lookup blank column data from multiple sheets based on the cell value in a column named "NDC." I want the macro to be universal so that if I call it on a sheet that has the "NDC" column, it will pull data into all blank cells based on the NDC column's cell value. I think I have it working so far, but the file I am working with is 300k rows.
I have the VBA code written within a UserForm in which the User selects the sheets to reference, and then loop through all columns to insert a vlookup formula into the blank cells. It works from what I can tell but takes forever to go through all of the rows, I was wondering if there is a faster method that I am not using here.
(Sorry if I'm not supposed to send entire chunks of code, but I want you to see where I am coming from and all the methods I'm using to achieve my goal) Thanks in advance!

UserForm1:

Option Explicit
Private wbReference As Workbook
Private wbActive As Workbook
Private wksActive As Worksheet

Private Sub butCancel_Click()
    Unload Me
End Sub

Private Sub butOK_Click()
    'Me.Tag = "OK"
    Me.Hide
    PullData Me.Items

End Sub

Private Sub UserForm_Initialize()
    Dim sh As Worksheet
    Dim ReferenceFileToOpen As Variant
    'Me.ListBox1.Clear
    Set wbActive = ActiveWorkbook
    Set wksActive = ActiveSheet
    ReferenceFileToOpen = Application.GetOpenFilename(Title:="Browse for Reference Excel File", FileFilter:=" Excel Files(*.xls*),*xls*")
    If ReferenceFileToOpen <> False Then
        Set wbReference = Application.Workbooks.Open(ReferenceFileToOpen)
        Dim n As Long
        For n = 1 To wbReference.Sheets.Count
            ListBox1.AddItem wbReference.Sheets(n).Name
        Next n
    End If
End Sub

Public Property Get Items() As String()
    Dim i As Long, selected As Long
    Dim selectedItems() As String
   
    For i = 0 To ListBox1.ListCount - 1
        If ListBox1.selected(i) = True Then
            ReDim Preserve selectedItems(selected)
            selectedItems(selected) = ListBox1.List(i)
            selected = selected + 1
        End If
    Next i
   
    Items = selectedItems
End Property

Sub PullData(ArrayItems() As String)
    'Application.ScreenUpdating = False
    'Application.DisplayAlerts = False

    Dim x As Integer
    Dim lastCol                 As Long
    Dim lr                      As Long
    Dim tb1                     As Range
    Dim tb2                     As Range
    Dim rActiveColHeaders       As Range
    Dim rReferenceColHeaders    As Range
    Dim rColHead                As Range                ' Iterates through the Reference column headers
    Dim rMatchColHead           As Range                ' Gets the matching column header
       
    lastCol = wksActive.Cells(1, Columns.Count).End(xlToLeft).Column
    lr = wksActive.Cells(Rows.Count, "A").End(xlUp).Row
    Set rActiveColHeaders = wksActive.Range(wksActive.Cells(1, 1), wksActive.Cells(1, lastCol))
   
    'CREATE TEMP COPY OF ACTIVE SHEET, CONVERT DATA INTO TABLE
    If Not DoesSheetExists("temp_data") Then
        wbActive.Sheets.Add(after:=wksActive).Name = "temp_data"
    End If
   
    wksActive.UsedRange.Copy (wbActive.Sheets("temp_data").Cells(1, 1))
    Set tb1 = wbActive.Sheets("temp_data").UsedRange
    wbActive.Sheets("temp_data").ListObjects.Add(xlSrcRange, tb1, , xlYes).Name = "tempTable1"

    'highlight all blank cells to unhighlight later
    wbActive.Sheets("temp_data").UsedRange.SpecialCells(xlCellTypeBlanks).Interior.Color = vbYellow
   
    'Loop from the lower bound of the Reference sheets array to the upper bound of the array - the entire array
    For x = LBound(ArrayItems) To UBound(ArrayItems)
        Debug.Print ArrayItems(x) & " was Selected.."
        'CREATE TEMP REFERENCE SHEET, CONVERT INTO TABLE
        If Not DoesSheetExists("temp_ref") Then
            wbActive.Sheets.Add(after:=wbActive.Sheets("temp_data")).Name = "temp_ref"
        End If
       
        wbReference.Sheets(ArrayItems(x)).UsedRange.Copy (wbActive.Sheets("temp_ref").Cells(1, 1))
        Set tb2 = wbActive.Sheets("temp_ref").UsedRange
        wbActive.Sheets("temp_ref").ListObjects.Add(xlSrcRange, tb2, , xlYes).Name = "tempTable2"
       
        lastCol = wbActive.Sheets("temp_ref").Cells(1, Columns.Count).End(xlToLeft).Column
        Set rReferenceColHeaders = wbActive.Sheets("temp_ref").Range(wbActive.Sheets("temp_ref").Cells(1, 1), wbActive.Sheets("temp_ref").Cells(1, lastCol))
   
        ' process
           '==========================================
           ' - loop through the Reference column header cells
           ' -- try to find the matching column
           ' -- if a match is found, set blank cell values to vlookup from NDC column and highlight found data
        For Each rColHead In rReferenceColHeaders
            Debug.Print rColHead & " header initiated.."
            For Each rMatchColHead In rActiveColHeaders
                If rMatchColHead.Value = rColHead.Value Then
                'Populate all blank cells in found/matched columns based on header name
                    If Not rColHead.Value = "NDC" Then
                        'tempTable1 [rColHead.Value].SpecialCells(xlCellTypeBlanks).Value = _
                         '   "=IFERROR(VLOOKUP([@NDC],tempTable2,MATCH(rColHead.Value,tempTable2[#Headers],0),0),FALSE)"
                        Debug.Print rColHead & " header Found!"
                        Dim blankRng As Range
                        With wbActive.Sheets("temp_data").ListObjects("tempTable1").ListColumns(rColHead.Value).DataBodyRange
                            On Error Resume Next 'ignore error if no blanks
                            Set blankRng = .SpecialCells(xlCellTypeBlanks)
                            On Error GoTo 0
                            If Not blankRng Is Nothing Then blankRng.Value = _
                                "=IFERROR(VLOOKUP([@NDC],tempTable2,MATCH(tempTable1[[#Headers],[" & rColHead & "]],tempTable2[#Headers],0),0),FALSE)"
                        End With
                    Else
                        Debug.Print "NDC header Found!"
                    End If
                Else
                    Debug.Print rColHead & " looking for match.."
                End If
            Next rMatchColHead
        Next rColHead

    wbActive.Sheets("temp_ref").Delete
    Next x
   
    wbActive.Sheets("temp_data").Select
   
    'unhighlight not found cells and display rows with highlighted data
    wbActive.Sheets("temp_data").UsedRange.SpecialCells(xlCellTypeBlanks).Interior.ColorIndex = xlNone
    'remove all rows with unhighlighted data to show what rows have been changed
    'copy highlighted data from temp_data into the main sheet


End Sub

Function DoesSheetExists(sh As String) As Boolean
    Dim ws As Worksheet

    On Error Resume Next
    Set ws = ActiveWorkbook.Sheets(sh)
    On Error GoTo 0

    If Not ws Is Nothing Then DoesSheetExists = True
End Function

 

[SkywardPalm]

I seem to be having an issue with pulling in the proper data into each column as well.. the column named "Size" is pulling from the column named "Manufacturer". This happens on multiple columns and the code stops before finishing with a "Run-time error '1004': Application-defined or object-defined error" on this line of the VBA code:

                            If Not blankRng Is Nothing Then blankRng.Value = _
                                "=IFERROR(VLOOKUP([@NDC],tempTable2,MATCH(tempTable1[[#Headers],[" & rColHead & "]],tempTable2[#Headers],0),0),FALSE)"