VBA Help - Comparing Two CSV Files

[Bigwelshal]

Hi All,

I have the below code which compares files in two different folders with the same name and outputs the different lines. I need to edit this so that it asks to select two files with different names rather than looking at all files in two folders but shows the same output. I have been trying to edit this myself but am a bit stuck, any help would be greatly appreciated.

Many thanks!

Sub CompareTwoFoldersTXTFiles()
'9/23/2014 - Jerry Beaucaire
'Compare identically named text files in two folders and list the differences line by line
'Missing files are also noted
Dim fPATH1 As String, fPATH2 As String, fNAME1 As String, fNAME2 As String
Dim f1 As String, f2 As String, temp1 As String, temp2 As String
Dim wsOUT As Worksheet, NR As Long, Cnt As Long

With Application.FileDialog(msoFileDialogFolderPicker)  'get folder names
    .Title = "CHOOSE FOLDER 1"
    .AllowMultiSelect = False
    .InitialFileName = "C:\2013\TextFiles1\"
    .Show
    If .SelectedItems.Count > 0 Then
        fPATH1 = .SelectedItems(1) & Application.PathSeparator
    Else
        Exit Sub
    End If
 
    .Title = "CHOOSE FOLDER 2"
    .InitialFileName = "C:\2013\TextFiles2\"
    .Show
    If .SelectedItems.Count > 0 Then
        fPATH2 = .SelectedItems(1) & Application.PathSeparator
    Else
        Exit Sub
    End If
End With

On Error Resume Next
    MkDir fPATH1 & "DONE"       'create DONE folders to temporarily store processed files
    MkDir fPATH2 & "DONE"
On Error GoTo 0
Application.ScreenUpdating = False                      'speed up macro, no screen draws

Set wsOUT = Sheets.Add(After:=Sheets(Sheets.Count))     'create report sheet
With wsOUT
    .Range("A1:B1").Value = [{"Filename", "Row #"}]     'add titles
    .Range("C1") = fPATH1
    .Range("D1") = fPATH2
    .Range("A1:D1").Font.Bold = True
    .Range("A2").Select
    ActiveWindow.FreezePanes = True                     'lock the top row
    NR = 2                                              'next empty row
 
    fNAME1 = Dir(fPATH1 & "*.csv")                      'get first filename from folder1
    Do While Len(fNAME1) > 0                            'process each file individually
        fNAME2 = Dir(fPATH2 & fNAME1)                   'check for same file in folder2
        If Len(fNAME2) = 0 Then                         'make sure file exists
            .Range("A" & NR).Value = fNAME1             'if not, note that
            .Range("D" & NR).Value = "Does not exist"
            NR = NR + 1
        Else                                            'if so, compare them line by line
            Cnt = 0
            Open fPATH1 & fNAME1 For Input As #1        'open folder1 file
                Open fPATH2 & fNAME2 For Input As #2    'open folder2 file
                Do Until EOF(1)
                    Cnt = Cnt + 1                       'make note of the line #
                    Line Input #1, temp1                'read in the line from file1
                    Line Input #2, temp2                'read in the line from file2
                    If temp1 <> temp2 Then              'compare the line, write them down if different
                        .Range("A" & NR).Value = fNAME1
                        .Range("B" & NR).Value = Cnt
                        .Range("C" & NR).Value = temp1
                        .Range("D" & NR).Value = temp2
                        NR = NR + 1                     'next empty row
                    End If
                Loop
                Close #2                                'close file2 and move it
                Name fPATH2 & fNAME2 As fPATH2 & "DONE\" & fNAME2
            Close #1                                    'close file1
        End If
        Name fPATH1 & fNAME1 As fPATH1 & "DONE\" & fNAME1   'move file1
        fNAME1 = Dir(fPATH1 & "*.csv")                  'get next file1 name
    Loop
 
    fNAME2 = Dir(fPATH2 & "*.csv")                  'get first extra filename from folder 2
    Do While Len(fNAME2) > 0                        'list all found extra files
        .Range("A" & NR).Value = fNAME2
        .Range("C" & NR).Value = "Does not exist"
        NR = NR + 1
     
        fNAME2 = Dir                                'next extra file
    Loop
 
    Shell "cmd /c move " & fPATH1 & "DONE\*.* " & fPATH1, vbHide    'move text files back to original position all at once
    Shell "cmd /c move " & fPATH2 & "DONE\*.* " & fPATH2, vbHide    'move text files back to original position all at once
    Application.Wait (Now + #12:00:03 AM#)                          'wait 3 seconds for cmd lines to complete
 
    RmDir fPATH1 & "DONE"   'delete the created DONE folders
    RmDir fPATH2 & "DONE"
 
    .Columns.AutoFit        'clean up the result
End With
Application.ScreenUpdating = True       'update the screen
End Sub

 

[ranman256]

sub startTheCompare()

vFile1= UserPick1File()
if vFile1 = "" then exit sub

vFile2= UserPick1File()
if vFile2 = "" then exit sub

'==== run compare

end sub



Public Function UserPick1File(Optional pvPath)
Dim strTable As String
Dim strFilePath As String
Dim sDialogMsg As String, sDecr  As String, sExt As String
Const msoFileDialogViewList = 1
Const msoFileDialogSaveAs = 2
Const msoFileDialogFilePicker = 3

'getFilterTxt pvFilter, sDecr, sExt, sDialog
If IsMissing(pvPath) Then pvPath = "c:\"

'Application.FileDialog(msoFileDialogSaveAs) =2     'SAVE AS
'Application.FileDialog(msoFileDialogFilePicker) =3  'file OPEN

With Application.FileDialog(3)   'MUST ADD REFERENCE : Microsoft Office XX.0 Object Library
    .AllowMultiSelect = True
    .Title = sDialogMsg   ' "Locate a file to Import"
    .ButtonName = "Import"
    .Filters.Clear
    .Filters.Add sDecr, sExt
        '.Filters.Add "Access Files", "*.accdb;*.mdb"
        '.Filters.Add "Excel Files", "*.xlsx"
    .Filters.Add "All Files", "*.*"
    .InitialFileName = pvPath
    .InitialView = msoFileDialogViewList    'msoFileDialogViewThumbnail

        If .show = 0 Then
           'There is a problem
           Exit Function
        End If

    'Save the first file selected
    UserPick1File = Trim(.SelectedItems(1))
End With
End Function