View Single Post
  #14   Report Post  
Posted to microsoft.public.excel.misc
Roberto R Roberto R is offline
external usenet poster
 
Posts: 11
Default Comparing Data from two 2 worksheets

Sorry Dave, but I'm completely lost now!! This is obviously way over my
head! Is there any way I can send you a small extract of the kind of sheets
I am thinking of, say for example 10 rows and you can advise?

Thanks in advance


"Dave Peterson" wrote in message
...
I made the change and pasted into the message, then I made one more
minor(!)
change and broke it.

This version fixes the first error:

Option Explicit
Sub testme()

Application.ScreenUpdating = False

Dim MstrWks As Worksheet
Dim NewWks As Worksheet

Dim MstrKeyRange As Range
Dim NewKeyRange As Range
Dim myCell As Range
Dim destCell As Range

Dim LastCol As Long

Dim iCol As Long
Dim res As Variant

Set MstrWks = ActiveWorkbook.Worksheets("sheet1")
Set NewWks = ActiveWorkbook.Worksheets("sheet2")

With MstrWks
Set MstrKeyRange = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
.Cells.Interior.ColorIndex = xlNone 'remove all fill color!
End With

With NewWks
Set NewKeyRange = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
.Cells.Interior.ColorIndex = xlNone
End With

LastCol = 6 'A to F
MstrWks.Columns(LastCol + 1).Clear
For Each myCell In MstrKeyRange.Cells
With myCell
res = Application.Match(.Value, NewKeyRange, 0)
If IsError(res) Then
.Parent.Cells(.Row, LastCol + 1).Value _
= "Not on other sheet"
myCell.EntireRow.Resize(1, LastCol).Interior.ColorIndex = 5
Else
For iCol = 1 To LastCol - 1
If .Offset(0, iCol).Value _
= NewKeyRange(res).Offset(0, iCol).Value Then
'do nothing, they match
Else
.Offset(0, iCol).Interior.ColorIndex = 3
.Parent.Cells(.Row, LastCol + 1).Value _
= "Changed"
End If
Next iCol
End If
End With
Next myCell

'check for newly added entries
For Each myCell In NewKeyRange.Cells
With myCell
res = Application.Match(.Value, MstrKeyRange, 0)
If IsError(res) Then
'missing from new workbook!
.Parent.Cells(myCell.Row, LastCol + 1).Value _
= "Added"
myCell.EntireRow.Resize(1, LastCol).Interior.ColorIndex = 7
Else
'already in the master
'don't do anything
End If
End With
Next myCell

Application.ScreenUpdating = True

End Sub

As for the changing the key column, try this one:

Option Explicit
Sub testme()

Application.ScreenUpdating = False

Dim MstrWks As Worksheet
Dim NewWks As Worksheet

Dim MstrKeyRange As Range
Dim NewKeyRange As Range
Dim myCell As Range
Dim destCell As Range
Dim KeyCol As Long
Dim StartRow As Long
Dim LastCol As Long
Dim iCol As Long
Dim res As Variant

Set MstrWks = ActiveWorkbook.Worksheets("sheet1")
Set NewWks = ActiveWorkbook.Worksheets("sheet2")

StartRow = 2 'headers in row 1
KeyCol = 3 'column C

With MstrWks
Set MstrKeyRange = .Range(.Cells(StartRow, KeyCol), _
.Cells(.Rows.Count, KeyCol).End(xlUp))
.Cells.Interior.ColorIndex = xlNone 'remove all fill color!
End With

With NewWks
Set NewKeyRange = .Range(.Cells(StartRow, KeyCol), _
.Cells(.Rows.Count, KeyCol).End(xlUp))
.Cells.Interior.ColorIndex = xlNone
End With

LastCol = 6 'A to F
MstrWks.Columns(LastCol + 1).Clear
For Each myCell In MstrKeyRange.Cells
With myCell
res = Application.Match(.Value, NewKeyRange, 0)
If IsError(res) Then
.Parent.Cells(.Row, LastCol + 1).Value _
= "Not on other sheet"
myCell.EntireRow.Resize(1, LastCol).Interior.ColorIndex = 5
Else
For iCol = 1 To LastCol
If iCol = KeyCol Then
'skip it
Else
If .Parent.Cells(.Row, iCol).Value _
= NewKeyRange.Parent _
.Cells(res + StartRow - 1, iCol).Value
Then
'do nothing, they match
Else
.Parent.Cells(.Row, iCol).Interior.ColorIndex =
3
.Parent.Cells(.Row, LastCol + 1).Value _
= "Changed"
End If
End If
Next iCol
End If
End With
Next myCell

'check for newly added entries
For Each myCell In NewKeyRange.Cells
With myCell
res = Application.Match(.Value, MstrKeyRange, 0)
If IsError(res) Then
'missing from new workbook!
.Parent.Cells(myCell.Row, LastCol + 1).Value _
= "Added"
myCell.EntireRow.Resize(1, LastCol).Interior.ColorIndex = 7
Else
'already in the master
'don't do anything
End If
End With
Next myCell

Application.ScreenUpdating = True

End Sub


Roberto R wrote:

Hi Dave, I noticed that I have to invert the order of the sheets in the
macro. In other words I set the "new" sheet as the MstrWks and the
original
or "old" sheet as the NewWks to get it report all the changes on the
"new"
sheet as required.

I'm still getting the same error but only if the MstrWks sheet has more
rows
or part numbers in it than the NewWks. Not sure why(?).

The macro works fine though despite the error message except for one
thing:
if parts are deleted on the "new" sheet, these are not reported as
"missing"
or "deleted" on the "old" sheet! Any ideas?

Apart from that the Macro works fine.

I worked out how to change the colors (thanks) also.

One more question:

If the sheet has more than 6 columns and the "part number" column is not
column A but say column F or something, which paramters do I change in
the
Macro?
Is it
LastCol = 6 'A to F
and
Set NewKeyRange = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
Set MstrKeyRange = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))

Regards

"Dave Peterson" wrote in message
...
Start a new workbook--you'll close without saving later
Tools|Macro|Record macro (into that workbook)

Change the fill color of a few cells

Stop recording the macro

You'll see the numbers for the colors you chose.

===
And you're going to have to be more specific about the error--what line
did it
occur on?

If it was one of those sheet name lines, try typing the names again.
You
have a
typo.

(It could be true. You typed shhet1 instead of sheet1 in your post
<bg.)

Roberto R wrote:

Hi Dave,
sorry but it doesn't seem to work. I tried using F8 and it gives me a
run
time error 9 and nothing happens on the sheets. What do you mean by
recording a macro when I change the fill colors? All I did was paste
your
code into the VBE and changed the shhet1 and sheet 2 names.

Help!!

Thanks again

"Dave Peterson" wrote in message
...
Record a macro when you change the fill color for 3 cells. Look at
the
code to
pick out the colors that you want.

Then look for .colorindex (3 times) to change in this:

Option Explicit
Sub testme()

Application.ScreenUpdating = False

Dim MstrWks As Worksheet
Dim NewWks As Worksheet

Dim MstrKeyRange As Range
Dim NewKeyRange As Range
Dim myCell As Range
Dim destCell As Range

Dim LastCol As Long

Dim iCol As Long
Dim res As Variant

Set MstrWks = ActiveWorkbook.Worksheets("sheet1")
Set NewWks = ActiveWorkbook.Worksheets("sheet2")

With MstrWks
Set MstrKeyRange = .Range("A2", .Cells(.Rows.Count,
"A").End(xlUp))
.Cells.Interior.ColorIndex = xlNone 'remove all fill color!
End With

With NewWks
Set NewKeyRange = .Range("A2", .Cells(.Rows.Count,
"A").End(xlUp))
.Cells.Interior.ColorIndex = xlNone
End With

LastCol = 6 'A to F
MstrWks.Columns(LastCol + 1).Clear
For Each myCell In MstrKeyRange.Cells
With myCell
res = Application.Match(.Value, NewKeyRange, 0)
If IsError(res) Then
.Parent.Cells(myCell.Row, LastCol + 1).Value _
= "Not on other sheet"
myCell.EntireRow.Resize(1,
LastCol).Interior.ColorIndex
= 5
Else
For iCol = 1 To LastCol - 1
If .Offset(0, iCol).Value _
= NewKeyRange(res).Offset(0, iCol).Value Then
'do nothing, they match
Else
' .Offset(0, iCol).Value _
' = NewKeyRange(res).Offset(0,
iCol).Value
.Offset(0, iCol).Interior.ColorIndex = 3
.Parent.Cells(myCell.Row, LastCol + 1).Value
_
= "Changed"
End If
Next iCol
End If
End With
Next myCell

'check for newly added entries
For Each myCell In NewKeyRange.Cells
With myCell
res = Application.Match(.Value, MstrKeyRange, 0)
If IsError(res) Then
'missing from new workbook!
' With MstrWks
' Set destCell _
' = .Cells(.Rows.Count,
"A").End(xlUp).Offset(1,
0)
' End With
' .Resize(1, LastCol).Copy _
' Destination:=destCell
destCell.Parent.Cells(destCell.Row, LastCol +
1).Value _
= "Added"
myCell.EntireRow.Resize(1,
LastCol).Interior.ColorIndex
= 7
Else
'already in the master
'don't do anything
End If
End With
Next myCell

Application.ScreenUpdating = True

End Sub


Roberto R wrote:

Thanks Dave, I tried the first suggestion.

What would be ideal would be to have the words "changed" and
"added"
on
each
row that has changed or been added on the "new" sheet only instead
of
on
the
"old" one whilst having "deleted" on the "old" sheet for any part
numbers
which are missing on the "new" sheet.

Also, is it possible to have the cells which have been "changed",
"added"
or
"deleted" to be coloured in 3 different colors WITHOUT the changes
actually
being applied?

I know I'm perhaps asking for a lot but now that I can "smell" the
final
goal, I'm inpatient to see it working!

Thanks again

"Dave Peterson" wrote in message
...
You can comment out the lines (put an apostrophe to the far left
of
that
line)
to make it not do the stuff you don't want it to do.

In this case, I think you only want to comment this section:

For iCol = 1 To LastCol - 1
If .Offset(0, iCol).Value _
= NewKeyRange(res).Offset(0, iCol).Value
Then
'do nothing, they match
Else
' .Offset(0, iCol).Value _
' = NewKeyRange(res).Offset(0,
iCol).Value
.Offset(0, iCol).Interior.ColorIndex = 3
.Parent.Cells(myCell.Row, LastCol +
1).Value
_
= "Changed"


Just add those 2 apostrophes and see if that works.

I'm not sure what should happen to the Added stuff. If you
really
want
those
gone, you can just comment these lines.

'check for newly added entries
' For Each myCell In NewKeyRange.Cells
' With myCell
' res = Application.Match(.Value, MstrKeyRange, 0)
' If IsError(res) Then
' 'missing from new workbook!
' With MstrWks
' Set destCell _
' = .Cells(.Rows.Count,
"A").End(xlUp).Offset(1,
0)
' End With
' .Resize(1, LastCol).Copy _
' Destination:=destCell
' destCell.Parent.Cells(destCell.Row, LastCol +
1).Value
_
' = "Added"
' Else
' 'already in the master
' 'don't do anything
' End If
' End With
' Next myCell

But I don't think you'll get the information that you want.




Roberto R wrote:

Hi again,

IT WORKS! Sorry Dave, it was my security setting that was
stopping
it
from
working.
I noticed it physically changes the data in the "old" sheet to
make
it
exactly the same as the "new" sheet, colours the cell and adds
the
words
"changed" or "added" next to the row.
Is it possible for it to highlight cells that reuire changing or
have
been
added (or deleted) without it actually doing the changes? That
would
be
fantastic!

Thanks again

<<snipped

--

Dave Peterson

--

Dave Peterson


--

Dave Peterson