Compare 2 Lists (Multiple Columns not consecutive)

DagsVic

New Member
Joined
Jun 4, 2015
Messages
2
Hi All,

I am comparing 2 lists..
List 1 is my manually entered list.
List 2 is collected using VBA.
The lists are 2 do with my movie collection, has worked very well to date but i want to make it so List 2 checks List 1 then only displays the files not listed or that do not match for whatever reason.

Below is my code i have so far that works but is very very slow to compare..
Code:
Sub ListUnknown(ByVal SourceFolderName As String)
'
Dim FSO As Object
Dim SourceFolder As Object
Dim FileItem As Object
Dim r As Long
Set wshtFiles = Sheets("File_Tasks")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(SourceFolderName)
wshtFiles.Range("H7").Value = Date & " - " & Time
wshtFiles.Range("B2:D3000").ClearContents
r = wshtFiles.Range("B3000").End(xlUp).Row + 1
del = r
'Application.ScreenUpdating = False
For Each FileItem In SourceFolder.Files
  ' Display file properties
  wshtFiles.Cells(r, 2).Formula = FileItem.Name
  wshtFiles.Cells(r, 3).Value = Right(wshtFiles.Cells(r, 2), 4)
  wshtFiles.Cells(r, 2).Value = Left(wshtFiles.Cells(r, 2).Value, Len(wshtFiles.Cells(r, 2).Value) - 4)
  wshtFiles.Cells(r, 4).Value = FileItem.Size / 1024
  r = r + 1 ' next row number
Next FileItem
'
 wshtFiles.Range("B2:D2001").Sort Key1:=wshtFiles.Range("B2"), _
    order1:=xlAscending, Header:=xlNo
'Application.ScreenUpdating = False
'
' FINISHED LISTING ALL FILES
'
' COMPARE BOTH LISTS (My Current List vs Actual Files in Folder)
'
Set sht_myfiles = Sheets("MOVIES LIST")

For i = 4 To 3000
    'MsgBox ("My Files Row: " & i & " ")
    CurrentFileName = sht_myfiles.Cells(i, 4).Value & sht_myfiles.Cells(i, 5).Value & sht_myfiles.Cells(i, 11).Value
    For j = 2 To 2001
    CurrentFile = wshtFiles.Cells(j, 2).Value & wshtFiles.Cells(j, 3).Value & wshtFiles.Cells(j, 4).Value
            'MsgBox ("Current File Name: " & CurrentFileName & " " _
            '& vbCrLf & "Current File: " & CurrentFile & " ")
'
        If sht_myfiles.Cells(i, 4).Value = "" Then
            i = 3000
            j = 3000
        ElseIf sht_myfiles.Cells(i, 4).Value & sht_myfiles.Cells(i, 5).Value & sht_myfiles.Cells(i, 11).Value = wshtFiles.Cells(j, 2).Value & wshtFiles.Cells(j, 3).Value & wshtFiles.Cells(j, 4).Value Then
                wshtFiles.Cells(j, 2).Value = ""
                wshtFiles.Cells(j, 3).Value = ""
                wshtFiles.Cells(j, 4).Value = ""
                j = 2
        End If
    Next j
Next i
'Application.ScreenUpdating = True
MsgBox "Finished collecting Files"
 wshtFiles.Range("B2:D2001").Sort Key1:=wshtFiles.Range("B2"), _
    order1:=xlAscending, Header:=xlNo
'
MsgBox "FINISHED LISTING FILES"
'
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
End Sub

Once this seems to work a bit better i will then be looking into having the Lists work in a way that compares files from my Backup HDD and the NAS.
Then it will list the differences of the 2 locations and allow me to modify if needed.
Once i'm happy i click a macro that will delete old files off HDD and copy across from NAS in it's place..

Any help to speed up the Compare stuff would be great as a starter..

Oh there are approx 2000 files it goes through..
The section which lists the files works very quickly, but the compare and clear contents part takes about 15mins which is a long time..

Cheers in advance..
 

Some videos you may like

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".

DagsVic

New Member
Joined
Jun 4, 2015
Messages
2
** Sorry to BUMP **

Does anyone know how to possibly speed up my code as per above post?
It runs well but very very slow..
 

Watch MrExcel Video

Forum statistics

Threads
1,122,556
Messages
5,596,820
Members
414,104
Latest member
imamalidadashzada

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
Top