Macro: Need to find all unmatched Data

[pdx_2188]

I currently have a macro that validates one column Vs. another column and extrapulates all matched data.

I now want to reverse this and only find the all the part numbers that are not matches. i know this is probably easy, but i just can't play around enough with the code for it to work. Any ideas?

[VBA]Sub Button1_Click()
UserForm1.Label1.Width = 0
UserForm1.Show
End Sub
Sub Macro1()
'
' Macro1 Macro
'
Application.ScreenUpdating = False
Sheets("Input").Select
Range("A2").Select
If ActiveCell.Value <> "" Then
If ActiveCell.Offset(0, 2) <> "" And ActiveCell.Offset(0, 5) <> "" And ActiveCell.Offset(0, 6) <> "" Then
Sheets("BlackBox").Select
Range("A2").Select
Dim ArrBB(300000) As String
Dim BBCount As Long

'populate array with values
For BBCount = 2 To ActiveSheet.UsedRange.Rows.count + 1
If ActiveCell.Value = "" Then
Exit For
End If
Range("A" & BBCount).Select
ArrBB(BBCount) = ActiveCell.Value
Next BBCount

'loop through input and check each against bb array
Dim InputCount As Long
Dim Loopcount As Long
Dim place As Long

Sheets("Input").Select
place = 2

For InputCount = 2 To ActiveSheet.UsedRange.Rows.count
Range("A" & InputCount).Select
For Loopcount = 1 To BBCount
If ActiveCell.Value = ArrBB(Loopcount) And ActiveCell.Value <> "" Then
Worksheets("Output").Range("A" & place) = ActiveCell.Offset(0, 0).Value
Worksheets("Output").Range("B" & place) = ActiveCell.Offset(0, 1).Value
Worksheets("Output").Range("C" & place) = ActiveCell.Offset(0, 2).Value
Worksheets("Output").Range("D" & place) = ActiveCell.Offset(0, 3).Value
Worksheets("Output").Range("E" & place) = ActiveCell.Offset(0, 4).Value
Worksheets("Output").Range("F" & place) = ActiveCell.Offset(0, 5).Value
Worksheets("Output").Range("G" & place) = ActiveCell.Offset(0, 6).Value

place = place + 1
Exit For
End If
Next Loopcount

UserForm1.FrameProgress.Caption = Round(((InputCount / ActiveSheet.UsedRange.Rows.count) * 100), 2) & "%"
UserForm1.Label1.Width = (InputCount / ActiveSheet.UsedRange.Rows.count) * 200
DoEvents

Next InputCount

Unload UserForm1

Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True

Sheets("Instructions").Select

MsgBox "Successfully completed with " & place - 1 & " matches and no errors."
Else
MsgBox "Please make sure there are values for columns: MFPN:, Quantity:, Region:, Date:,Partner Name, and Invoice #"
End If
Else
MsgBox "Please put data into Input page first."
End If

End Sub[/VBA]

[mdmackillop]

Can you post some sample data on which to run your code.

[pdx_2188]

Here you are! In order to make it fit I had to shrink it down a bit.

Thanks for you help!

Jeff

[pdx_2188]

Can you post some sample data on which to run your code.

Maybe I need to redo it; however, looking at the code I believe I would like to change this line?

 ArrBB(BBCount) = ActiveCell.Value

To be something like this:

ArrBB(BBCount) <> ActiveCell.Value

But it just gives me a syntax error, so in this case i don't know the exact code. I tried and If/Then but I'm not sure how to end it?

If ArrBB(BBcount) <> ActiveCell.Vale then Sheets("Output")

But I'm not sure if I should be declaring the range in BlackBox or what I should take a look at, any ideas?

Sorry for bothering you, but you just seem to have some great other posts, and seem to really know your stuff!

Thanks again!

[mdmackillop]

This avoids looping. Add a sheet called "Found" to your workbook. While there were no problems with your progress bar, I removed it here for clarity.

[VBA]Sub Macro1()

Dim Arr
Dim x As Long
Dim Inputt As Range
Dim Cel As Range
Dim r As Long, rw As Long, i As Long

Application.ScreenUpdating = False

'populate array with values
With Sheets("BlackBox")
Arr = Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp))
End With

With Sheets("Input")
Set Inputt = Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp))
End With

For Each Cel In Inputt
i = i + 1
On Error Resume Next
x = Application.Match(Inputt(i), Arr, 0)
If x > 0 Then
'Match Found
r = r + 1
Worksheets("Found").Range("A" & r).Resize(, 7).Value = Cel.Resize(, 7).Value
Else
'No match
rw = rw + 1
Worksheets("Output").Range("A" & rw).Resize(, 7).Value = Cel.Resize(, 7).Value
End If
x = 0
Next
MsgBox "Matched -" & vbTab & r & vbCr & "Unmatched -" & vbTab & rw


End Sub

[/VBA]

[GTO]

Hi all,

Not utterly sure if I'm searching in the correct direction, but if looking to see if vals in Input are non-matched in BlackBox - just another way...

Option Explicit
    
Sub exa()
Dim DIC         As Object '<--- Dictionary
Dim wksInput    As Worksheet
Dim wksOutput   As Worksheet
Dim wksBlackBox As Worksheet
Dim rngBlack    As Range
Dim rngInput    As Range
Dim Cell        As Range
Dim i           As Long
    
    Set DIC = CreateObject("Scripting.Dictionary")
    
    Set wksInput = ThisWorkbook.Worksheets("Input")
    Set wksOutput = ThisWorkbook.Worksheets("Output")
    Set wksBlackBox = ThisWorkbook.Worksheets("BlackBox")
    
    With wksBlackBox
        Set rngBlack = Range(.Range("A2"), .Cells(.Rows.Count, "A").End(xlUp))
    End With
    
    ReDim aryBlack(1 To UBound(rngBlack.Value, 1), 1 To 1)
    
    For i = 1 To UBound(rngBlack.Value, 1)
        DIC.Item(rngBlack(i, 1).Value) = rngBlack(i, 1).Value
    Next
    
    With wksInput
        Set rngInput = Range(.Range("A2"), .Cells(.Rows.Count, "A").End(xlUp))
    End With
    
    For Each Cell In rngInput
        If Not DIC.Exists(Cell.Value) Then
            wksOutput.Cells(wksOutput.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 7).Value _
                = Cell.Resize(, 7).Value
        End If
    Next
End Sub

Mark

[GTO]

ACK! No reason to include ea key's item.

    For i = 1 To UBound(rngBlack.Value, 1)
        DIC.Item(rngBlack(i, 1).Value) = Empty
    Next

[pdx_2188]

MDMackIllop: When you ran this macro, did the Message box read "0" matches and the rest are all unmatched?. Because it seems to just pulling all data from WKS.Input into WKS.Output, but not actually going through and validating the unmatched. Their should be far less unmatched then matched, since i'm essentially using Intel (as matched) vs. AMD part numbers. Just curious if I'm just not inputting it correctly.


GTO: When I run this macro it seems to just move the contents in Input into Output and does not seem to filter againts the blackbox.

Sorry for being so annoying, we are just so close to getting this figured out!

[mdmackillop]

In your posted sample there are no data in Input Column A which match Blackbox Column A. I inserted some matches to test the code.

[pdx_2188]

In your posted sample there are no data in Input Column A which match Blackbox Column A. I inserted some matches to test the code.

I added my own matches/non-matches like you did, and it worked.

After this I ran data that I know is not in the blackbox Worksheet and it still said it had x number of matches and no unmatched. Any ideas why it would be working if we create rows verse the rows that I need it to actually check againts?

[mdmackillop]

Can you post your revised sample data with a copy of your expected result.

[pdx_2188]

Yes I will I'm just dealing with going over the 1mb. Is their any way around this, so i can send you the exact file I'm working with?

[pdx_2188]

Well, now I'm really confused. I used much less data then I'm normally working with, and used the AMD(26000 rows) MFPNs in the BlackBox instead of the Intel (220000) rows, and it appears to work. I'll add the zip folder. While you take a look at this, I'm going to attempt to just recreate this from a new workbook and see if this will make a difference.

[mdmackillop]

Please repost unprotected workbook. It's too much hassle to find and enter passwords.

[pdx_2188]

I removed the instructions tab on this one, and it just has the macro being ran in the Module section. This one seems to work properly, and it has the smaller part number list instead of the larger one. But whould this matter since they are dim'd as long?

This version Gives me: 421 Matched, and 5711 Unmatched

[pdx_2188]

Forgot to unlock

[mdmackillop]

Sheets still protected.

[pdx_2188]

Do you think there may be a row limit. Because when i take my long list of 180k rows it does not work, but when i use the same BlackBox data set and delete a number of rows (60K in total) it works. Would it be possible to expand the look up method to accept that many rows? I tried to upload my long list but it's about 1.5 mb zipped up.

[pdx_2188]

Second attachment not protected

[mdmackillop]

Try this revision
[VBA]Sub Macro1()

Dim Arr As Range
Dim x As Long
Dim Inputt As Range
Dim Cel As Range
Dim r As Long, rw As Long, i As Long

Application.ScreenUpdating = False

'Set reference to Blackbox range
With Sheets("BlackBox")
Set Arr = Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp))
End With

'Set reference ti Input range
With Sheets("Input")
Set Inputt = Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp))
End With

'Look at each Cell in Input; try to find it in Arr (Blackbox)
For Each Cel In Inputt
Set c = Arr.Find(Cel)
If c Is Nothing Then
'No Match; increment Output counter
rw = rw + 1
'Write values from corresponding cell x 7 columns to Output
Worksheets("Output").Range("A" & rw).Resize(, 7).Value = Cel.Resize(, 7).Value
Else
'Match; Increment Found counter
r = r + 1
'Write values from corresponding cell x 7 columns to Found
Worksheets("Found").Range("A" & r).Resize(, 7).Value = Cel.Resize(, 7).Value
End If
'Record process in Statusbar
Application.StatusBar = r + rw & " : Found:=" & r

Next
Application.ScreenUpdating = True
MsgBox "Matched -" & vbTab & r & vbCr & "Unmatched -" & vbTab & rw
Application.StatusBar = ""


End Sub[/VBA]