find unique values in different spreadsheets.

MartinL

Well-known Member
Joined
Oct 16, 2008
Messages
1,141
Office Version
  1. 365
Platform
  1. Windows
Hi

I have 2 years worth of spreadsheets and I need to make a list of all the unique items by item number (UPC) from them all,

The spreadsheets are all in two directories 2007 and 2008 the named Week 1 to Week 52 (2007) & Week 1 to Week 48 (2008)

All the items unique code (UPC) are in column C but could be from C4:C300 to C4:C350 in each spreadsheet.

How can I do this or will i need to copy and past col C from every spreadsheet into a master sheet to do this.....
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
I'm guessing what I was trying to do was not possible..

I have now copied 60 columns of data from 60 different spreadsheets into a single spreadsheet.

This spreadsheet is now from A4:BF30 and only contains item numbers
75% of these are duplicates and I need to find create a list of uniqe item numbers from this massive list.....

I was going to go down the pivot table route but I think that will not work due to the high number of columns.....

I'm tired and want to go to bed, It was the Christmas party on Saturday and my brain is still not functioning yet
 
Upvote 0
Hi,

Create backup copies of your file. Not tested.

Code:
Sub kTest()
Dim FileFolder As String
Dim dic As Object, w(), v, n As Long, a, Flg As Boolean
Dim fName As String, wb As Workbook, aWB As Workbook, ws As Worksheet

Set dic = CreateObject("scripting.dictionary")
dic.comparemode = vbTextCompare
FileFolder = "C:\2007\" 'change to suit
fName = Dir(FileFolder & "Week*.xls")
ReDim w(1 To Rows.Count, 1 To 1)
With Application
    .ScreenUpdating = 0
    .EnableEvents = 0
    .DisplayAlerts = 0
End With
Set aWB = ActiveWorkbook
Flg = False
DoAgain:
Do While fName <> ""
    If fName <> aWB.Name Then
        Set wb = Workbooks.Open(Filename:=FileFolder & fName, UpdateLinks:=0)
        With wb.Sheets(1)
            a = .Range("c4", .Range("c" & Rows.Count).End(xlUp))
        End With
        For Each v In a
            If Not IsEmpty(v) Then
                If Not dic.exists(v) Then
                n = n + 1: w(n, 1) = v: dic.Add v, Nothing
            End If
        Next
        Erase a
        wb.Close False
        Set wb = Nothing
        fName = Dir()
    End If
Loop
If Flg = False Then
    FileFolder = "C:\2008\" 'change to suit
    fName = Dir(FileFolder & "Week*.xls")
    Flg = True
    GoTo DoAgain
End If
Set ws = aWB.Sheets.Add
ws.Name = "UniqueCodes"
With ws.Range("a1")
    .Value = "Unique Codes"
    .Offset(1).Resize(n).Value = w
End With
Set dic = Nothing
With Application
    .ScreenUpdating = 1
    .EnableEvents = 1
    .DisplayAlerts = 1
End With
End Sub
 
Last edited:
Upvote 0

Forum statistics

Threads
1,212,938
Messages
6,110,782
Members
448,297
Latest member
carmadgar

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top