VBA identified Tables to compare values and skip if match

[DThib]

Help!!!

I have a code to look at a result table (QA_Table) column to make sure the results are not duplicated when adding new entries from a worksheet to the table. These two worksheets are in the same workbook.

I had it working and it stopped working. I have been tinkering with it and it just repeats the same results already in the table!

Here is the code:

Sub Newt()


    Dim MBs As Worksheet, Coos As Worksheet, QAws As Worksheet
    Dim MBRow As Long, CoRow As Long, QArow As Long
    Dim m As Long, j As Long, l As Long, g As Long
    Dim x As Long, y As Long, a As Long
    Dim b1 As String
[COLOR=#b22222]    Dim TBL1, TBL2, TabC As Range[/COLOR]


    
    Set MBs = ThisWorkbook.Sheets("MB51_Draw")
    Set Coos = ThisWorkbook.Sheets("COOIS_Draw")
    Set QAws = ThisWorkbook.Sheets("QA_Data")
    
[COLOR=#b22222]    Set tbl = Sheets("QA_Data") '.ListObjects("QA_Table")[/COLOR]
[COLOR=#b22222]    With tbl[/COLOR]
[COLOR=#b22222]      Set TBL1 = .Range("C2", .Range("C1").End(xlDown))[/COLOR]
[COLOR=#b22222]    End With[/COLOR]
[COLOR=#b22222]    Set searchw = Sheets("COOIS_Draw")[/COLOR]
[COLOR=#b22222]    With searchw[/COLOR]
[COLOR=#b22222]       Set TBL2 = .Range("A2", .Range("A1").End(xlDown))[/COLOR]
[COLOR=#b22222]    End With[/COLOR]

[COLOR=#b22222]      For Each TabC In TBL1[/COLOR]
[COLOR=#b22222]         If WorksheetFunction.CountIf(TBL2, TabC) = 0 Then[/COLOR]
[COLOR=#b22222]            tbl.Range("C" & Rows.Count).End(xlUp) = TabC[/COLOR]
            
            MBRow = MBs.Cells(Rows.Count, "B").End(xlUp).Row
            CoRow = Coos.Cells(Rows.Count, "B").End(xlUp).Row
            QArow = QAws.Cells(Rows.Count, "C").End(xlUp).Row
                j = QArow + 1
                g = MBRow
                m = CoRow
                 For m = 1 To CoRow
                  For g = 1 To MBRow
                     If Coos.Cells(m, 1) = MBs.Cells(g, 13).Value And MBs.Cells(g, 12) Like "5*" Then
                            QAws.Cells(j, 1) = Coos.Cells(m, 4).Value
                            QAws.Cells(j, 2) = Coos.Cells(m, 5).Value
                            QAws.Cells(j, 3) = MBs.Cells(g, 13).Value
                            QAws.Cells(j, 4) = MBs.Cells(g, 17).Value
                            QAws.Cells(j, 5) = MBs.Cells(g, 14).Value
                            j = j + 1
                     End If
                  Next g
                 Next m
         End If
      Next
   
End Sub

Trouble Code is in red

Arrrrgh,
DThib

 

[DThib]

Can you provide a dropbox location and I will send right over. My work will not allow me to use mine.

 

[NoSparks]

often suggested in the forum is using the free limited file storage and sharing at box.com

 

[DThib]

https://app.box.com/s/v6a0wdt2wv0lgj54kqazcdqeg32s9lkt

DThib

 

[NoSparks]

Sorry, I am totally confused as to what you're trying to do and how you're trying to do it.

From your original post

when adding new entries from a worksheet to the table

based on the file you've provided, can you tell me what to do to accomplish that, from what worksheet, what columns to what table ?

 

[DThib]

Worksheets:
(QA_Data) generates entries from the other two worksheets (MB51_Draw, COOIS_Draw).
The initial data will compare a value in 1 column (Order) in COOIS_Draw to 1 column (Batch) in MB51_Draw.
If a matching ID is found, look back into MB51_Draw to (Material Document) for a number starting with 5.

This is the data that gets added to the table in QA_Data tab. Only matches meeting both conditions. Both MB51_Draw & COOIS_Draw are files that will append data from the macro that copies certain files in. As these will continue adding data and the data from different files being added to the MB51_Draw & COOIS_Draw will match, the Userform button "Add Data MB51/COOIS Files" will be clicked.

I am trying to add language to "Add Data MB51/COOIS Files" macro to look in column 3(Lot/Batch Number) of QA_Data worksheet, compare for a match from COOIS_Draw worksheet column 1 (Order).

If there is a match, skip the entry, it will already be in the QA_Data worksheet table, and continue the macro to find new matches between MB51_Draw & COOIS_Draw as stated above.

DThib

 

[NoSparks]

Your file with revised code
https://app.box.com/s/fvz5ahypnnobwkham6ewcufrwz40p103

Sub Newt()

    Dim Coos As Worksheet, MBs As Worksheet, QAWs As Worksheet
    Dim COr As Range, MBr As Range
    Dim cel As Range, fndRng As Range
    Dim tbL As ListObject, oNewRow As ListRow

'set the worksheets
    Set MBs = ThisWorkbook.Sheets("MB51_Draw")
    Set Coos = ThisWorkbook.Sheets("COOIS_Draw")
    Set QAWs = ThisWorkbook.Sheets("QA_Data")

'set ranges and table
    With Coos
       Set COr = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
    End With
    
    With MBs
        Set MBr = .Range("M1", .Range("M" & .Rows.Count).End(xlUp))
    End With
        
    With QAWs
       Set tbL = .ListObjects(1)    'first table on sheet
    End With
    
Application.ScreenUpdating = False

'check if value in COr (order) exists in MBr (batch)
    For Each cel In COr
        Set fndRng = MBr.Find(What:=cel.Value, LookIn:=xlValues, LookAt:=xlWhole, _
                              SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
            
        If Not fndRng Is Nothing Then   'meaning it was found
            'look back into MB51_Draw to (Material Document) for a number starting with 5
            If Left(fndRng.Offset(, -1).Value, 1) = 5 Then
                'check if already in table tbL
                With tbL
                    If WorksheetFunction.CountIf(.ListColumns(3).DataBodyRange, cel.Value) = 0 Then
                        'not found so add to the table
                        Set oNewRow = .ListRows.Add
                        With oNewRow.Range
                            .Cells(1, 1) = cel.Offset(, 3).Value            'Coos.Cells(m, 4).Value
                            .Cells(1, 2) = cel.Offset(, 4).Value            'Coos.Cells(m, 5).Value
                            .Cells(1, 6) = cel.Offset(, 12).Value           'Coos.Cells(m, 13).Value
                            .Cells(1, 3) = fndRng.Value                     'MBs.Cells(g, 13).Value
                            .Cells(1, 4) = fndRng.Offset(, 4).Value         'MBs.Cells(g, 17).Value
                            .Cells(1, 5) = fndRng.Offset(, 1).Value         'MBs.Cells(g, 14).Value
                        End With
                    End If
                End With
            End If
        End If
    Next cel
    
Application.ScreenUpdating = True

MsgBox "The data has been evaluated", vbInformation + vbOKOnly, "QA Sterilized Package Movement"
   
End Sub

 

[DThib]

NoSparks,

You have plenty of spark!!!
Thank you for the code. I tried it and it works beautifully.
Redirecting the queries and setting the workbook searches worked.

Thanks again.

DThib

 

[DThib]

It is only capturing a subset of the positive results!
I have data that may have blanks in some rows as it is copied over.
The number that is the second part of the logic check before pulling data is a number that begins with 5 but is a 10 figure number. It is only pulling a subset

DThib

HELP!!!

 

[DThib]

Bump!!

 

[NoSparks]

Don't understand what you mean by only pulling a subset.