Home |
Search |
Today's Posts |
#6
![]()
Posted to microsoft.public.excel.misc
|
|||
|
|||
![]()
Tried, works fine although I need to ensure that the columns I use don't
change at otherwise it replicates the part as if it were a new one. Thanks very much for all your help!! Regards "Roberto R" wrote in message ... Thanks Dave, I'll try it and let you know. "Dave Peterson" wrote in message ... Maybe you can make some unique identifier column by concatenating the supplier and the part number. Then use that for the key column. Roberto R wrote: Hi Dave, sorry it's taken me so long to reply but I was trying out your macro on the "live" spreadsheet. 7600+ rows and 40 columns of data and it works perfectly!!! THANK YOU VERY MUCH!!! There's only one more question, I have noticed that on the spreadsheet, the "part number" can actually appear twice on the same sheet! One of the columns on the spreadsheet indicates the supplier of that particular part. On rare occasions, the same part number is supplied by 2 different suppliers or the supplier can change from month to month as business is awarded or resourced. When running the macro, the second time it finds the same part numbers, it highlights cells refering the differences to the first time instance of the same part number (i.e. sales volumes, prices, supplier name, etc.) and them as "changed" although both rows containing the same part number are actually both correct and no changes have been made. Any ideas? Thanks again "Dave Peterson" wrote in message ... try copying that second routine into your workbook's project. Make the same changes you made before (sheet names and colors). And these two lines will need to be changed: StartRow = 2 'headers in row 1 KeyCol = 3 'column C I assumed that there were headers in row 1, so the data started in row 2. And I assumed that the key column was in column C now--not column A. Then try it out. Roberto R wrote: 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 -- Dave Peterson -- Dave Peterson |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
macro | Excel Discussion (Misc queries) | |||
Match and Sort for two range of data on different worksheets? | New Users to Excel | |||
ranking query | Excel Discussion (Misc queries) | |||
Sharing data across worksheets within a workbook based on identifi | Excel Discussion (Misc queries) | |||
sharing rows of data across multiple worksheets within a workbook | Excel Worksheet Functions |