VBA identified Tables to compare values and skip if match

DThib

Active Member
Joined
Mar 19, 2010
Messages
427
Can you provide a dropbox location and I will send right over. My work will not allow me to use mine.
 

Some videos you may like

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.

NoSparks

Well-known Member
Joined
Mar 15, 2013
Messages
958
Office Version
2010
Platform
Windows
often suggested in the forum is using the free limited file storage and sharing at box.com
 

NoSparks

Well-known Member
Joined
Mar 15, 2013
Messages
958
Office Version
2010
Platform
Windows
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 ?
 
Last edited:

DThib

Active Member
Joined
Mar 19, 2010
Messages
427
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
 
Last edited:

NoSparks

Well-known Member
Joined
Mar 15, 2013
Messages
958
Office Version
2010
Platform
Windows
Your file with revised code
https://app.box.com/s/fvz5ahypnnobwkham6ewcufrwz40p103

Code:
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

Active Member
Joined
Mar 19, 2010
Messages
427
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

Active Member
Joined
Mar 19, 2010
Messages
427
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:confused:

DThib

HELP!!!
 

NoSparks

Well-known Member
Joined
Mar 15, 2013
Messages
958
Office Version
2010
Platform
Windows
Don't understand what you mean by only pulling a subset.
 

Subscribe on YouTube

Watch MrExcel Video

Forum statistics

Threads
1,105,959
Messages
5,508,403
Members
408,681
Latest member
JustinJ

This Week's Hot Topics

Top