Save compared results to new work book
A friend of mine has given me the following ... which
works fine ... however the are numbers which were once
settled which are now live. Therefore, although there are
no duplication in the new sheet .. there are rows that
were in the old sheets (either Live & settled, Live or
Settled ) depending on the row
So if possible I would like the Macro to compare all six
sheet against each other so that there are no rows that
were in any of the previous sheets.
if this is unclear .. please let me know
Function Column_Number(c)
'---------------------------------------------
'This function is used to determine the
'number of rows an the active range. Accepts
' C as string and returns the number of rows
'---------------------------------------------
Range(c).Activate
ActiveCell.CurrentRegion.Select
Column_Number = Selection.Rows.Count
End Function
Sub Comparison()
Cells.Select
Selection.ClearContents
file1 = "SETTLED old.xls"
file2 = "SETTLED new.xls"
Workbooks.Open Filename:="D:\Advertising\SETTLED new.xls"
Workbooks.Open Filename:="D:\Advertising\SETTLED old.xls"
elements = Column_Number("A1")
Windows(file2).Activate
elements2 = Column_Number("A1")
'MsgBox ("These are the number of elements in the original
file " & elements)
'MsgBox ("These are the number of elements in the second
file " & elements2)
'-----Minimize the Relevant Windows
Windows(file1).Activate
ActiveWindow.WindowState = xlMinimized
Windows(file2).Activate
ActiveWindow.WindowState = xlMinimized
For i = 2 To elements
Windows(file1).Activate
For J = 2 To elements2
If (Range("A" + CStr(i)).Value = _
Workbooks(file2).Sheets("SETTLED new") _
.Range("A" + CStr(J)).Value) Then
'----- If the same information is found highlight
the cells
Windows(file2).Activate
Range("A" + CStr(J)).EntireRow.Delete
elements2 = elements2 - 1
'Range("A" + CStr(J), "Z" + CStr(J)).Select
'With Selection.Interior
' .ColorIndex = 6
'.Pattern = xlSolid
'End With
Exit For
End If
Next J
Next i
Application.StatusBar = False
'---------- Copy the information to the New sheet
Application.DisplayAlerts = False
Workbooks.Open Filename:="D:\Advertising\Settled.xls"
Cells.Select
Selection.ClearContents
Windows(file2).Activate
Cells.Select
Selection.Copy Workbooks("Settled.xls").Sheets("Settled") _
.Range("A1")
' ActiveWorkbook.SaveAs Filename:="D:\Advertising\New Live
and Settled.xls", _
' FileFormat:=xlNormal, Password:="",
WriteResPassword:="", _
' ReadOnlyRecommended:=False, CreateBackup:=False
Windows(file1).Activate
ActiveWindow.Close
Windows(file2).Activate
ActiveWindow.Close
ActiveWindow.WindowState = xlMaximized
End Sub
-----Original Message-----
Every week, I have the task of running a report and using
a Vlookup to check if the row exists. I run a report
every week that I want to compare 3 pairs of excel
sheets. Each week I will compare the sheets, one would
be
current and the other would be a week old. The current 3
pairs should not have any of the rows of the previous
week's 3 pairs nor should there be any row the same
between the current 3 pairs. I would appreciate is
someone could assist with a macro that will first compare
each pair against its previous week. It would check the
first value in a1 empeeID against the previous week
always using column A for comparison. if it finds the
same
row, delete (or highlight) the entire row. Any new
values
existing in the current would be saved to a new book.
this
would continue for the next 2 pairs. then it would open
the now 3 newly saved workbooks and check column a for
any
duplicate rows between them. As before, any duplicates
delete, new values saved to a single new sheet. I hope
this is clear. please post for additional clarity
Many thanks in advance
E. Grayham
.
|