If you have two Excel Sheets with content in it and you want to simply compare them, just follow this instruction.

We do have Excel ‘20180904_SheetOne’

SheetOne.PNG

…and Excel ‘20180904_SheetTwo’:

SheetTwo

Step 1: Control-Sheet with Button

We need an empty sheet for our Code which I name ‘Control‘. Be aware of the file, that it is an xlsm-file. Otherwise you can’t execute any Makros.

Open your Excel Sheet ‘Control’ and now we need the DevelopperTools. Normally, they are not shown, so you have to go via Options…

01.PNG

… edit menu and show developper tools:

02.PNG

Now you got them on top:

03.PNG

To draw a button we want to click on afterwards, go to ‘insert’ – ‘Active-X-Elements’ and choose the Button-Option. Your mouse is now a simple cross. Press your mouse and draw your button:

04.PNG

Step 2: Customize button

To customize this button, press ALT + F11 and rename the Button (Caption):

05.PNG

There’s written a little Code automatically. There, you have to enter (see further steps) your functions to be executed step by step.

I always rename the spreadsheets. They are automatically renamed in our Code-Project (the right side of the window):

06.PNG

Step 3: Some more information

For my example, I want to compare these Sheets every single day. That’s why I re-named the two Excel files with a date (20180904…). So we start by adding some information to the spreadsheet ‘Compare’:

07.PNG

 

Please note that there are several formulas in column C:

date of comparison: =HEUTE()

file path of first ExcelSheet: C:\Users\STA\Desktop\Scriptss\Neuer Ordner\VBA

name of first ExcelSheet: =JAHR(C8)&TEXT(MONAT(C8);"00")&TEXT(TAG(C8);"00")&"_SheetOne.xls"

file path of second ExcelSheet: C:\Users\STA\Desktop\Scriptss\Neuer Ordner\VBA

name of second ExcelSheet: =JAHR(C8)&TEXT(MONAT(C8);"00")&TEXT(TAG(C8);"00")&"_SheetTwo.xls"

Archive directory for first ExcelSheet: C:\Users\STA\Desktop\Scriptss\Neuer Ordner\VBA

Archive directory for second ExcelSheet: C:\Users\STA\Desktop\Scriptss\Neuer Ordner\VBA

file path and name for generated compare-file: ="C:\Users\STA\Desktop\Scriptss\Neuer Ordner\VBA"&"\"&JAHR(C8)&TEXT(MONAT(C8);"00")&TEXT(TAG(C8);

 

Step 4: Start coding

If you already closed your code-view, you should open it again with ALT + F11.

Double-click on ‘ThisWorkbook’ and enter the following Code:

14.PNG

Private Sub Workbook_Open()

    Sheets("Compare").Activate

End Sub

This code is used, so that the workbook opens always on the front-page.

Step 5: First function – Import Files

Then, I want to import all necessary files. So the first thing to execute by clickin’ the button is my first function ‘ImportFiles‘.

09.PNG

Now I need the function itself. For that, change row after ‘End Sub’ and write the following function. Your Code window is going to switch from CommandButton and Click to another window.

15.PNG

Private Sub ImportFiles()

Dim path As String
Dim file As String
Dim i As Integer
Dim k As Integer


Application.DisplayAlerts = False

For i = 9 To 10

path = Sheets("Compare").Range("C" & i).Value & "\"
file = path & Sheets("Compare").Range("D" & i).Value

If Dir(file) <> "" Then
Workbooks.Open Filename:=file
ActiveWorkbook.Worksheets(1).UsedRange.Copy
ThisWorkbook.Sheets(i - 7).Paste
ActiveWorkbook.Close
End If

Next i


End Sub

What we are doing here: We go two times through the code. The first time, we do start in row number 9 and safe our path (file path for first ExcelSheet) under the variable ‘path’. And we safe our file name inclusive path under the variable ‘file’. Then we check, if there is any file. If there is no SheetOne, we skip the If-Part and go on to next i (9+1=10). If there is a file, we do open it, copy the used ranges, and paste it into the second worksheet (i = 9 –> 9 – 7 = 2). Now we go on with next i. Next i is 9 + 1 = 10. Same procedure. Next i would be 11, but our loop goes only to 10, so this function is finished.

Step 6: Make the records unique for SheetOne

Comparing several rows is much easier, if the row is represented by one single unique identifier. So we need a second function which is written right under our first one:

11

And we sure need some code for that. So once again, after ‘End Sub’, write ‘Private Sub UniqueIdentifyFile1() End Sub’ and you will get the following new window:

12

Code:

Private Sub UniqueIdentifyFile1()

Dim i As Integer
Dim lastRow As Integer
Dim Name As String
Dim Birthday As String
Dim Draftsman As String
Dim Superhero As String
Dim Owner As String

Sheets("SheetOne").Range("G1").Value = "Unique Identifier"

lastRow = Sheets("SheetOne").Cells(Rows.Count, 1).End(xlUp).Row

Sheets("SheetOne").Select

For i = 2 To lastRow

Name = Sheets("SheetOne").Range("A" & i).Value
Birthday = Sheets("SheetOne").Range("B" & i).Value
Draftsman = Sheets("SheetOne").Range("C" & i).Value
Superhero = Sheets("SheetOne").Range("D" & i).Value
Owner = Sheets("SheetOne").Range("E" & i).Value

Sheets("SheetOne").Range("G" & i).Value = Name & Birthday & Draftsman & Superhero & Owner

Next i

End Sub

Let me explain:

Range G1 in our SheetOne is the first empty space after all filled spaces. So we want to input our Unique Identifier there. That’s why we label this row ‘Unique Identifier’. Then, we want to know how many rows are filled in our SheetOne and set this number as our variable lastRow.

G1 is labeled, and after this, G2, G3, G4,… until G’lastRow’, we want to insert the identifier. As we start with G2, our counter i is 2. In our example, we do have 7 rows, so the loop is done six times (2, 3, 4, 5, 6, 7) before the function is finished.

Step 7: Make the records unique for SheetTwo

I think there’s not much explanation needed, because you only have to copy Step 6 and change ‘SheetOne’ in the code for ‘SheetTwo’. To be sure, here’s the code once again:

Private Sub UniqueIdentifyFile2()

Dim i As Integer
Dim lastRow As Integer
Dim Name As String
Dim Birthday As String
Dim Draftsman As String
Dim Superhero As String
Dim Owner As String

Sheets("SheetTwo").Range("G1").Value = "Unique Identifier"

lastRow = Sheets("SheetTwo").Cells(Rows.Count, 1).End(xlUp).Row

Sheets("SheetTwo").Select

For i = 2 To lastRow

Name = Sheets("SheetTwo").Range("A" & i).Value
Birthday = Sheets("SheetTwo").Range("B" & i).Value
Draftsman = Sheets("SheetTwo").Range("C" & i).Value
Superhero = Sheets("SheetTwo").Range("D" & i).Value
Owner = Sheets("SheetOne").Range("E" & i).Value

Sheets("SheetTwo").Range("G" & i).Value = Name & Birthday & Draftsman & Superhero & Owner

Next i

End Sub

Step 8: Search identifier of SheetOne in SheetTwo

Now, I want to know, if my unique identifier of SheetOne is contained in SheetTwo. So I start a search via lookUp:

Private Sub LookUpFIle1()

Dim Wsf As WorksheetFunction
Dim Arbeitsmappe As Workbook
Dim Datenbasis As Worksheet
Dim Bereich As Range
Dim lastRow As Integer

Sheets("SheetOne").Select

Set Arbeitsmappe = ThisWorkbook
Set Datenbasis = Arbeitsmappe.Worksheets("SheetTwo")
Set Bereich = Datenbasis.Range("G:G")
Set Wsf = Application.WorksheetFunction

lastRow = Sheets("SheetOne").Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To lastRow
On Error Resume Next

Sheets("SheetOne").Range("H" & i).Value = Wsf.VLookup(Sheets("SheetOne").Range("G" & i).Value, Bereich, 1, False)

Next i

End Sub

Don’t forget to add this function to your buttonClick functions!

Our range is the range we are searching for our identifier lastRow is the number of every rows of our SheetOne, so that we can’t forget a row. Then business as usual: a loop! The value of my search is written into range H&i of my SheetOne.

Step 9: Search identifier of SheetTwo in SheetOne

Here we go again with nearly the same code:

Private Sub LookUpFile2()

Dim Wsf As WorksheetFunction
Dim Arbeitsmappe As Workbook
Dim Datenbasis As Worksheet
Dim Bereich As Range
Dim lastRow As Integer

Sheets("SheetTwo").Select

Set Arbeitsmappe = ThisWorkbook
Set Datenbasis = Arbeitsmappe.Worksheets("SheetOne")
Set Bereich = Datenbasis.Range("G:G")
Set Wsf = Application.WorksheetFunction

lastRow = Sheets("SheetTwo").Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To lastRow
On Error Resume Next

Sheets("SheetTwo").Range("H" & i).Value = Wsf.VLookup(Sheets("SheetTwo").Range("G" & i).Value, Bereich, 1, False)

Next i

End Sub

 

Step 10: Filter the identifiers not found on Sheet One

If there are any differences in the two Sheets, we will get some identifiers not found. To filter them, we need a filter 😉

Public Sub FilterOne()

  Sheets("SheetOne").Range("A:H").AutoFilter Field:=8, Criteria1:=""

End Sub

Step 11: Filter the identifiers not found on Sheet Two

Public Sub FilterTwo()

Sheets("SheetTwo").range("A:H").AutoFilter Field:=8, Criteria1:=""

End Sub

 

Step 12: Copy everything into our compare-file

Now, we want to copy the necessary findings into our new compare-file. No worry, here’s the code for that:

Private Sub Finalcopy()

Dim targetfilename As String
Dim targetWorkbook As Workbook

targetfilename = Sheets("Compare").range("C13").Value

Sheets("SheetOne").Select

ActiveSheet.Copy

ActiveWorkbook.SaveAs targetfilename

Set targetWorkbook = ActiveWorkbook

ThisWorkbook.Sheets("SheetTwo").Activate
ThisWorkbook.Sheets("SheetTwo").Copy After:=targetWorkbook.Worksheets(1)

targetWorkbook.Close SaveChanges:=True

End Sub

With C13, we get the path and name of our compare-file. The two filtered Sheets are each selected, copied and pasted into the compare-file. The compare-file is closed and saved (with every changes).

Step 13 – Move files to Archive

We want to move the old files ‘20180904_SheetOne’ and ‘20180904_SheetTwo’ into our Archive:

   Private Sub moveFile()

    Dim pathSheetOneSoFar As String 
    Dim pathSheetOneArchive As String
    Dim pathSheetTwoSoFar As String
    Dim pathSheetTwoArchive As String

    pathSheetOneSoFar = Sheets("Compare").Range("C" & 9 ).Value & "\" & Sheets("Compare").Range("D" & 9).Value
    pathSheetOneArchive = Sheets("Compare").Range("C" & 11).Value & "\" & Sheets("Compare").Range("D" & 11).Value
    pathSheetTwoSoFar = Sheets("Compare").Range("C" & 10).Value & "\" & Sheets("Compare").Range("D" & 10).Value
    pathSheetTwoArchive = Sheets("Compare").Range("C" & 12).Value & "\" & Sheets("Compare").Range("D" & 12).Value

    If Dir(pathSheetOneSoFar) <> "" Then
    FileCopy pathSheetOneSoFar, pathSheetOneArchive
    Kill pathSheetOneSoFar
    End If

    If Dir(pathSheetTwoSoFar) <> "" Then 
    FileCopy pathSheetTwoSoFar, pathSheetTwoArchive
    Kill pathSheetTwoSoFar 
    End If

    End Sub

 

Step 14: Remove all filter in the old Control-Sheet

To empty our Control-Sheet afterwards, we first need to remove all filters via Code:

Private Sub removeFilters()

With Sheets("SheetOne")
If .FilterMode Then
.ShowAllData
End If
End With

With Sheets("SheetTwo")
If .FilterMode Then
.ShowAllData
End If
End With


End Sub

Looks easy – is easy.

Step 15: Empty all

To start the next day as today, we need to empty SheetOne and SheetTwo of our Control Sheet. If we would not do this, it could be a bugg. For example imagine the following. Today, we got 7 rows of records. Tomorrow, we got only 5. The last two rows would not be removed and perhaps it could cause differences from the last day.

Private Sub emptyAll()

Dim i As Integer

For i = 2 To 3

Worksheets(i).Activate
Worksheets(i).UsedRange.ClearContents
Sheets(i).range("A1").Select

Next i

' ThisWorkbook.Close SaveChanges:=True
ThisWorkbook.Save
Application.Quit

End Sub

Step 16: Sit back and enjoy

Hope this code helps you doing your work faster and flawless. Keep using your head!

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google+ photo

You are commenting using your Google+ account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

This site uses Akismet to reduce spam. Learn how your comment data is processed.

Category

Microsoft Excel VBA

Tags

, , , , , , , , , ,