VB Script

[NWE]

Hello

I am new here and wanted to get some help on something. I downloaded the spreadsheet compare tool and I wanted to make a modification to it. I wanted to add in a script that would spit out a simple text detailing the differences in the individual columns that are compared. For example: There was 5 percent change in column A on spreadsheet 1 to column A on spreadsheet two. I have already inserted the button into the module and I just need to decide would a loop work or something similar to the processes already found in the tool. Any help provided will be greatly appreciated and sorry if this is a simple question, I am new to VB in general.

[Logit]

.
To assist you, more often than not, a picture does not provide sufficient information to work with.
Posting a copy of your workbook, less any confidential information, showing a before and after example ... as well as a clear explanation of what
is expected to occur when the macro / formula is run ... would be of great assistance to those wanting to assist you.

[NWE]

.
To assist you, more often than not, a picture does not provide sufficient information to work with.
Posting a copy of your workbook, less any confidential information, showing a before and after example ... as well as a clear explanation of what
is expected to occur when the macro / formula is run ... would be of great assistance to those wanting to assist you.

Thanks for the assist. I have attached the workbook with the two worksheets that I want to compare. I would like the macro to compare the spreadsheets for differences. I know there are already a lot of custom built macros out there that do this, however the kicker is I want it to come in a simple report stating the differences.

[Logit]

.
See if this works ... paste the macro into a module. Place a command button on the second sheet.
The macro compares Sheet1 against Sheet2 and highlights the differences in Sheet2.



Sub Compare3()
Dim rDatabase As Range, rFile As Range
Dim iFile As Long, iDatabase As Long, iColumn As Long

Set rDatabase = Worksheets("Database").Cells(1, 1).CurrentRegion
Set rFile = Worksheets("File").Cells(1, 1).CurrentRegion

rFile.Interior.Color = xlNone

For iFile = 2 To rFile.Rows.Count

iDatabase = -1

On Error Resume Next
iDatabase = Application.WorksheetFunction.Match(rFile.Cells(iFile, 1).Value, rDatabase.Columns(1), 0)
On Error GoTo 0

If iDatabase <> -1 Then
For iColumn = 2 To rFile.Columns.Count
' changed to add CStr()'s
If CStr(rFile.Cells(iFile, iColumn).Value) <> CStr(rDatabase.Cells(iDatabase, iColumn).Value) Then
rFile.Cells(iFile, iColumn).Interior.Color = vbRed
End If

If CStr(rDatabase.Cells(iDatabase, iColumn).Value) = "" Then
rFile.Cells(iFile, iColumn).Interior.Color = xlNone
End If
Next iColumn
End If
Next iFile

End Sub

[NWE]

Ok a few other questions

What would I assign the button to do? and would this code go under or above the button code?

[NWE]

Also I get the following error
'9' Subscript out of range

[Logit]

.
See attached :

[NWE]

I see. so to expand on that a bit, I had a macro that did that, what I wanted to do was generate a workbook that gave a simple break down of the changes.

for example
There was a 5% percent error from column A in worksheet 1 to column A on worksheet 2..something of that scope? I know some macros add it in as a simple text at the end.

[Logit]

.
Try this :



Option Explicit


Sub Compare3()
Dim rDatabase As Range, rFile As Range
Dim iFile As Long, iDatabase As Long, iColumn As Long

Set rDatabase = Worksheets("Baseline").Cells(1, 1).CurrentRegion
Set rFile = Worksheets("Built").Cells(1, 1).CurrentRegion

rFile.Interior.Color = xlNone

For iFile = 2 To rFile.Rows.Count

iDatabase = -1

On Error Resume Next
iDatabase = Application.WorksheetFunction.Match(rFile.Cells(iFile, 1).Value, rDatabase.Columns(1), 0)
On Error GoTo 0

If iDatabase <> -1 Then
For iColumn = 2 To rFile.Columns.Count
' changed to add CStr()'s
If CStr(rFile.Cells(iFile, iColumn).Value) <> CStr(rDatabase.Cells(iDatabase, iColumn).Value) Then
rFile.Cells(iFile, iColumn).Interior.Color = vbRed
End If

If CStr(rDatabase.Cells(iDatabase, iColumn).Value) = "" Then
rFile.Cells(iFile, iColumn).Interior.Color = xlNone
End If
Next iColumn
End If
Next iFile
CompareSheets
End Sub
Sub CompareSheets()
Dim rg1 As Range
Dim rg2 As Range
Dim rw As Long
rw = 1
For Each rg1 In Sheet1.Range("C1:C65536")
If rg1 <> Sheet3.Cells(rg1.Row, rg1.Column) Then
rw = rw + 1
Sheet2.Cells(rw, 1) = rg1
Sheet2.Cells(rw, 2) = Sheet3.Cells(rg1.Row, rg1.Column)
End If
Next rg1
LastRow
End Sub
Sub LastRow()

Dim LastRow1 As Integer
Dim LastRow2 As Integer

LastRow1 = Sheets("Baseline").UsedRange.Rows.Count - 1
LastRow2 = Sheets("Differences").UsedRange.Rows.Count


Sheets("Differences").Range("G2").Value = Sheets("Differences").UsedRange.Rows.Count


Sheets("Differences").Range("G4").Value = (LastRow2 / LastRow1)


End Sub

[NWE]

Thank you!

Would there be a way to say the following:
"there were x percent difference between Column A/Sheet 1 and Column B/Sheet2"

Wouldn't you just put the names of the columns under the
"Sheets("Differences").Range("G2").Value = Sheets("Differences").UsedRange.Rows.Count" parameter?

[Logit]

.


Sub LastRow()

Dim LastRow1 As Integer
Dim LastRow2 As Integer

LastRow1 = Sheets("Baseline").UsedRange.Rows.Count - 1
LastRow2 = Sheets("Differences").UsedRange.Rows.Count


Sheets("Differences").Range("G2").Value = Sheets("Differences").UsedRange.Rows.Count


Sheets("Differences").Range("G4").Value = (LastRow2 / LastRow1)


MsgBox "There were " & FormatPercent((LastRow2 / LastRow1), , , vbTrue) & " difference between Column A / Sheet1 and Column B / Sheet2", vbInformation, "Percent Difference"


End Sub

[Logit]

.


Sub LastRow()

Dim LastRow1 As Integer
Dim LastRow2 As Integer
Dim x As String
Dim y As String

LastRow1 = Sheets("Baseline").UsedRange.Rows.Count - 1
LastRow2 = Sheets("Differences").UsedRange.Rows.Count


x = Sheets("Differences").UsedRange.Rows.Count
y = FormatPercent((LastRow2 / LastRow1), , , vbTrue)


Sheets("Differences").Range("G2").Value = x


Sheets("Differences").Range("G4").Value = (LastRow2 / LastRow1)


'MsgBox "There were " & FormatPercent((LastRow2 / LastRow1), , , vbTrue) & " difference between Column A / Sheet1 and Column B / Sheet2", vbInformation, "Percent Difference"


MsgBox "There is a difference of " & x & " fixtures in the column ""Ex Code"" from Baseline to As Built for a difference of " & y & " percent."




End Sub

[NWE]

Option Explicit


Sub Compare3()
Dim rDatabase As Range, rFile As Range
Dim iFile As Long, iDatabase As Long, iColumn As Long

Set rDatabase = Worksheets("Baseline").Cells(1, 1).CurrentRegion
Set rFile = Worksheets("Built").Cells(1, 1).CurrentRegion

rFile.Interior.Color = xlNone

For iFile = 2 To rFile.Rows.Count

iDatabase = -1

On Error Resume Next
iDatabase = Application.WorksheetFunction.Match(rFile.Cells(iFile, 1).Value, rDatabase.Columns(1), 0)
On Error GoTo 0

If iDatabase <> -1 Then
For iColumn = 2 To rFile.Columns.Count
' changed to add CStr()'s
If CStr(rFile.Cells(iFile, iColumn).Value) <> CStr(rDatabase.Cells(iDatabase, iColumn).Value) Then
rFile.Cells(iFile, iColumn).Interior.Color = vbRed
End If

If CStr(rDatabase.Cells(iDatabase, iColumn).Value) = "" Then
rFile.Cells(iFile, iColumn).Interior.Color = xlNone
End If
Next iColumn
End If
Next iFile
CompareSheets
End Sub
Sub CompareSheets()
Dim rg1 As Range
Dim rg2 As Range
Dim rw As Long
rw = 1
For Each rg1 In Sheet1.Range("C1:C65536")
If rg1 <> Sheet3.Cells(rg1.Row, rg1.Column) Then
rw = rw + 1
Sheet2.Cells(rw, 1) = rg1
Sheet2.Cells(rw, 2) = Sheet3.Cells(rg1.Row, rg1.Column)
End If
Next rg1
LastRow
End Sub


Sub LastRow()

Dim LastRow1 As Integer
Dim LastRow2 As Integer
Dim x As String
Dim y As String

LastRow1 = Sheets("Baseline").UsedRange.Rows.Count - 1
LastRow2 = Sheets("Differences").UsedRange.Rows.Count




x = Sheets("Differences").UsedRange.Rows.Count
y = FormatPercent((LastRow2 / LastRow1), , , vbTrue)




Sheets("Differences").Range("G2").Value = x




Sheets("Differences").Range("G4").Value = (LastRow2 / LastRow1)




'MsgBox "There were " & FormatPercent((LastRow2 / LastRow1), , , vbTrue) & " difference between Column A / Sheet1 and Column B / Sheet2", vbInformation, "Percent Difference"




MsgBox "There is a difference of " & x & " fixtures in the column ""Ex Code"" from Baseline to As Built for a difference of " & y & " percent."
MsgBox "There is a difference of " & x & " fixtures in the column ""Ex Qty"" from Baseline to As Built for a difference of " & y & " percent."
MsgBox "There is a difference of " & x & " fixtures in the column ""PR Code"" from Baseline to As Built for a difference of " & y & " percent."
MsgBox "There is a difference of " & x & " fixtures in the column ""PR Qty"" from Baseline to As Built for a difference of " & y & " percent."






End Sub

I have made changes to the last line of code, I want it to be able to generate the results for each column compared, check and see where I messed up?

[Paul_Hossler]

@NWE -- I added CODE tags to your last post

You can use the [#] icon to insert CODE tags and paste your macro between them

It makes it easier to read and sets off the code

[Logit]

.
The percentages will all be the same because the formulas are referencing the total number of rows that do not match.

Rather than have so many message box notifications, condense it all into one message box and change the wording to suite ?
Some kind of generic statement that references all the areas.

[NWE]

I can put those statements into a message section on spreadsheet 3 that generates during the macro? Not as a message box but a line by line giving the exact count and a percentage? How can I make it do a plus or minus from one page to another? For example if I wanted to say the following:



'Generate Report = Worksheet3


There is a difference of (+/-) Fixtures in Column "Ex Code" for a difference of (+/-) percent


and so on for each column in plain text? Also If I am reading the code correct, this will work for any two spreadsheets right? as it just references them as worksheets and not necessarily the worksheet names?



Sub LastRow()
Dim LastRow1 As Integer
Dim LastRow2 As Integer
Dim x As String
Dim y As String


LastRow1 = Sheets("Baseline").UsedRange.Rows.Count - 1
LastRow2 = Sheets("Differences").UsedRange.Rows.Count


x = Sheets("Differences").UsedRange.Rows.Count
y = FormatPercent((LastRow2 / LastRow1), , , vbTrue)


Sheets("Differences").Range("G2").Value = x




Sheets("Differences").Range("G4").Value = (LastRow2 / LastRow1)


'Populate Differences Details
Sheets("Diifferences").Range("G6") = "There is a difference of " & x & " fixtures in the column ""Ex Code"" from Baseline to As Built for a difference of " & y & " percent."



End Sub


That was the last bit of code and I wanted to modify it with. I wanted to populate the text string in G6 or in another workbook but I keep getting "error 9" out of range.

[Logit]

.

but I keep getting "error 9" out of range.

It is most likely because the sheet names are different from the actual sheet names you are using. In the macro, change the "Differences" , "Baseline" & "Built" sheet names to the
actual names of the sheets you are referencing.

To write the percentage difference to the sheet instead of a MsgBox :



Sheets("Diifferences").Range("G6") = "There is a difference of " & x & " fixtures in the column ""Ex Code"" from Baseline to As Built for a difference of " & y & " percent."

Sheets("Diifferences").Range("G7") = "There is a difference of " & x & " fixtures in the column ""Ex Qty"" from Baseline to As Built for a difference of " & y & " percent."

Sheets("Diifferences").Range("G8") = "There is a difference of " & x & " fixtures in the column ""PR Qty"" from Baseline to As Built for a difference of " & y & " percent."


By studying the pattern for the Range("G #") and ""Ex Code"" or ""Ex Qty"",etc. I believe you can determine how to complete the others. Delete the line of code referencing the
MsgBox.

Reminder: Your percentages will still be the same for all categories for the reason previously outlined.


Please review your last post. Although you included the CODE tags, for some reason it did not translate as it should. Need to edit that for compliance. Thanks.

[Paul_Hossler]

@Logit -- Extra space at the end of the closing tag -- I fixed

@NWE - the [#] icon is easier, but the manually entered tags will work if perfect




…. macro …

[Logit]

.
Paul_Hossler (http://www.vbaexpress.com/forum/member.php?9803-Paul_Hossler) : Thanks

[Logit]

.
NWE

I managed to create a Pivot Table of the specific differences, broken down and reflecting the totals per category.

I say "managed" because I am not very knowledgeable with Pivot Tables.

[Paul_Hossler]

Is OK -- I saw the OP's extra space before I saw that you had already found it

[Logit]

NWE

Utilizing the Pivot Table created - total Fixture numbers and the total of all Fixtures from the Baseline sheet,
you can determine the difference and extrapolate the percentage as shown on the Differences sheet.

Refer to the attached.

Again, because the totals on the Baseline sheet are the same regardless of which column totals you use, the percentage difference will be the same for
all categories.

[NWE]

Hey

I am thinking the pivot table will be enough as long as I come up with a formula to calculate those percentages. I got help from another source on this using the following, however I don't know where to insert a formula that calculates percentage:

[CODE]
Sub comp()
Application.DisplayAlerts = False
Application.ScreenUpdating = False


'Set variables up
Dim varSheetA As Variant
Dim varSheetB As Variant
Dim strRangeToCheck As String
Dim iRow As Long
Dim iCol As Long


t = 6

'Clean out previous report data
Worksheets("Detail Report").Activate
Worksheets("Detail Report").Range("A2:A3").Select
Selection.ClearContents
Worksheets("Detail Report").Range("A7:H4000").Select
Selection.ClearContents
Worksheets("Summary Report").Activate
Worksheets("Summary Report").Range("A2:A3").Select
Selection.ClearContents
Worksheets("Summary Report").Range("A5:H4000").Select
Selection.ClearContents

'Set range to compare between sheets
strRangeToCheck = "A1:H4000"

'Set variable for each sheet
varSheetA = Worksheets("Baseline").Range(strRangeToCheck)
varSheetB = Worksheets("Built").Range(strRangeToCheck)

'Loop thru and do the comparison cell by cell via an array
For iRow = LBound(varSheetA, 1) To UBound(varSheetA, 1)
For iCol = LBound(varSheetA, 2) To UBound(varSheetA, 2)
If varSheetA(iRow, iCol) = varSheetB(iRow, iCol) Then
' Cells are identical.
' Do nothing.
Else
' Cells are different.

'get column letter from column number for reporting purposes
columnletter = Split(Cells(1, iCol).Address, "$")(1)

'Create detail report
Worksheets("Detail Report").Activate
Worksheets("Detail Report").Range("A" & t) = "$" & columnletter & "$" & iRow
Worksheets("Detail Report").Range("B" & t) = Worksheets("Baseline").Range("A" & iRow).Value

'Build Hyperlinks
Worksheets("Detail Report").Range("F" & t).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="Baseline%20Avondale.xlsx"

t = t + 1
End If
Next iCol
Next iRow


'Create Summary report
'Loop to find number of detail report rows
For x = 6 To 4000
If Worksheets("Detail Report").Range("A" & x) = "" Then
ender = x
x = 4001
End If
Next x


'Loop to get number details of detail report rows
For x = 6 To ender
If Worksheets("Detail Report").Range("C" & x) = "EX Code" Then
excode = excode + 1
End If

Next x


'Populate summary report details
Worksheets("Summary Report").Range("A1") = "There is a difference of " & excode & " fixtures in the column ""EX Code"" from Baseline to As Built"


End Sub
[CODE]