| Home |
| Search |
| Today's Posts |
|
|
|
#1
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
Please help with a "find duplicates" macro - 4/10/07
A while back someone was very helpful in solving a macro problem.
I need a little more assistance. The macro compared "Column A" in two worksheets (Master & Sub) and identified the duplicates by changing the cell background to red.. When the macro encountered it's first blank cell in the Master sheet the macro stopped running. This Macro worked great. I still need to compare the two worksheets "Column A" but when the macro sees duplicates it needs to delete the entire row in the Master worksheet. Below is the Macro I have been using... I am not sure if this macro can be modified or need a complete new macro? Any assistance would be appreciated. Sub FindDupes() 'assuming both sheets are in same book and book is open Dim sht1 As Worksheet Dim sht2 As Worksheet Dim cell1 As Range Dim cell2 As Range Dim str As String str = InputBox("Type name of first sheet") Set sht1 = Worksheets(str) str = InputBox("Type name of second sheet") Set sht2 = Worksheets(str) For Each cell1 In sht1.Columns(1).Cells If cell1.Value = "" Then Exit Sub For Each cell2 In sht2.Columns(1).Cells If cell2.Value = cell1.Value Then cell1.Interior.ColorIndex = 3 cell2.Interior.ColorIndex = 3 End If Next cell2 Next cell1 End Sub |
|
#2
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
|
Please help with a "find duplicates" macro - 4/10/07
Something like this:
.... 'cell1.Interior.ColorIndex = 3 'cell2.Interior.ColorIndex = 3 sht1.Rows(cell1.Row & ":" & cell1.Row).Delete Shift:=xlUp .... -- Rodrigo Ferreira "41db14" escreveu na mensagem ... A while back someone was very helpful in solving a macro problem. I need a little more assistance. The macro compared "Column A" in two worksheets (Master & Sub) and identified the duplicates by changing the cell background to red.. When the macro encountered it's first blank cell in the Master sheet the macro stopped running. This Macro worked great. I still need to compare the two worksheets "Column A" but when the macro sees duplicates it needs to delete the entire row in the Master worksheet. Below is the Macro I have been using... I am not sure if this macro can be modified or need a complete new macro? Any assistance would be appreciated. Sub FindDupes() 'assuming both sheets are in same book and book is open Dim sht1 As Worksheet Dim sht2 As Worksheet Dim cell1 As Range Dim cell2 As Range Dim str As String str = InputBox("Type name of first sheet") Set sht1 = Worksheets(str) str = InputBox("Type name of second sheet") Set sht2 = Worksheets(str) For Each cell1 In sht1.Columns(1).Cells If cell1.Value = "" Then Exit Sub For Each cell2 In sht2.Columns(1).Cells If cell2.Value = cell1.Value Then cell1.Interior.ColorIndex = 3 cell2.Interior.ColorIndex = 3 End If Next cell2 Next cell1 End Sub |
|
#3
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
|
Please help with a "find duplicates" macro - 4/10/07
Hi Rodrigo,
I edited the macro per your suggestion. The Macro stops and highlights in yellow the line...If cell2.Value = cell1.Value Then The error indicates it looking for a value? I ran the macro both with an without the comment indicator in front of the lines ' cell1.Interior.ColorIndex = 3 ' cell2.Interior.ColorIndex = 3 didn't seem to make any difference. Here is the entire macro with your suggested change Sub FindDupes() 'assuming both sheets are in same book and book is open Dim sht1 As Worksheet Dim sht2 As Worksheet Dim cell1 As Range Dim cell2 As Range Dim str As String str = InputBox("Type name of first sheet") Set sht1 = Worksheets(str) str = InputBox("Type name of second sheet") Set sht2 = Worksheets(str) For Each cell1 In sht1.Columns(1).Cells If cell1.Value = "" Then Exit Sub For Each cell2 In sht2.Columns(1).Cells If cell2.Value = cell1.Value Then €˜ cell1.Interior.ColorIndex = 3 €˜ cell2.Interior.ColorIndex = 3 sht1.Rows(cell1.Row & ":" & cell1.Row).Delete Shift:=xlUp End If Next cell2 Next cell1 End Sub ************************************************** ********* "Rodrigo Ferreira" wrote: Something like this: .... 'cell1.Interior.ColorIndex = 3 'cell2.Interior.ColorIndex = 3 sht1.Rows(cell1.Row & ":" & cell1.Row).Delete Shift:=xlUp .... -- Rodrigo Ferreira "41db14" escreveu na mensagem ... A while back someone was very helpful in solving a macro problem. I need a little more assistance. The macro compared "Column A" in two worksheets (Master & Sub) and identified the duplicates by changing the cell background to red.. When the macro encountered it's first blank cell in the Master sheet the macro stopped running. This Macro worked great. I still need to compare the two worksheets "Column A" but when the macro sees duplicates it needs to delete the entire row in the Master worksheet. Below is the Macro I have been using... I am not sure if this macro can be modified or need a complete new macro? Any assistance would be appreciated. Sub FindDupes() 'assuming both sheets are in same book and book is open Dim sht1 As Worksheet Dim sht2 As Worksheet Dim cell1 As Range Dim cell2 As Range Dim str As String str = InputBox("Type name of first sheet") Set sht1 = Worksheets(str) str = InputBox("Type name of second sheet") Set sht2 = Worksheets(str) For Each cell1 In sht1.Columns(1).Cells If cell1.Value = "" Then Exit Sub For Each cell2 In sht2.Columns(1).Cells If cell2.Value = cell1.Value Then cell1.Interior.ColorIndex = 3 cell2.Interior.ColorIndex = 3 End If Next cell2 Next cell1 End Sub |
|
#4
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
|
Please help with a "find duplicates" macro - 4/10/07
Look this code:
Sub FindDupes() 'assuming both sheets are in same book and book is open Dim sht1 As Worksheet Dim sht2 As Worksheet Dim cell1 As Range Dim cell2 As Range Dim str As String 'str = InputBox("Type name of first sheet") str = "Plan1" Set sht1 = Worksheets(str) 'str = InputBox("Type name of second sheet") str2 = "Plan2" Set sht2 = Worksheets(str2) sht1.Range("A65536").End(xlDown).Activate Selection.End(xlUp).Activate LastRowSht1 = ActiveCell.Row sht2.Activate sht2.Range("A65536").End(xlDown).Activate Selection.End(xlUp).Activate LastRowSht2 = ActiveCell.Row sht1.Activate For rowSht1 = 1 To LastRowSht1 If sht1.Cells(rowSht1, 1) = "" Then Exit Sub For rowSht2 = 1 To LastRowSht2 If sht1.Cells(rowSht1, 1).Value = sht2.Cells(rowSht2, 1).Value Then sht1.Cells(rowSht1, 1).Interior.ColorIndex = 3 sht2.Cells(rowSht2, 1).Interior.ColorIndex = 3 sht1.Rows(rowSht1 & ":" & rowSht1).Delete Shift:=xlUp End If Next Next sht1.Cells(1, 1).Select End Sub -- Rodrigo Ferreira "41db14" escreveu na mensagem ... Hi Rodrigo, I edited the macro per your suggestion. The Macro stops and highlights in yellow the line...If cell2.Value = cell1.Value Then The error indicates it looking for a value? I ran the macro both with an without the comment indicator in front of the lines ' cell1.Interior.ColorIndex = 3 ' cell2.Interior.ColorIndex = 3 didn't seem to make any difference. Here is the entire macro with your suggested change Sub FindDupes() 'assuming both sheets are in same book and book is open Dim sht1 As Worksheet Dim sht2 As Worksheet Dim cell1 As Range Dim cell2 As Range Dim str As String str = InputBox("Type name of first sheet") Set sht1 = Worksheets(str) str = InputBox("Type name of second sheet") Set sht2 = Worksheets(str) For Each cell1 In sht1.Columns(1).Cells If cell1.Value = "" Then Exit Sub For Each cell2 In sht2.Columns(1).Cells If cell2.Value = cell1.Value Then ' cell1.Interior.ColorIndex = 3 ' cell2.Interior.ColorIndex = 3 sht1.Rows(cell1.Row & ":" & cell1.Row).Delete Shift:=xlUp End If Next cell2 Next cell1 End Sub ************************************************** ********* "Rodrigo Ferreira" wrote: Something like this: .... 'cell1.Interior.ColorIndex = 3 'cell2.Interior.ColorIndex = 3 sht1.Rows(cell1.Row & ":" & cell1.Row).Delete Shift:=xlUp .... -- Rodrigo Ferreira "41db14" escreveu na mensagem ... A while back someone was very helpful in solving a macro problem. I need a little more assistance. The macro compared "Column A" in two worksheets (Master & Sub) and identified the duplicates by changing the cell background to red.. When the macro encountered it's first blank cell in the Master sheet the macro stopped running. This Macro worked great. I still need to compare the two worksheets "Column A" but when the macro sees duplicates it needs to delete the entire row in the Master worksheet. Below is the Macro I have been using... I am not sure if this macro can be modified or need a complete new macro? Any assistance would be appreciated. Sub FindDupes() 'assuming both sheets are in same book and book is open Dim sht1 As Worksheet Dim sht2 As Worksheet Dim cell1 As Range Dim cell2 As Range Dim str As String str = InputBox("Type name of first sheet") Set sht1 = Worksheets(str) str = InputBox("Type name of second sheet") Set sht2 = Worksheets(str) For Each cell1 In sht1.Columns(1).Cells If cell1.Value = "" Then Exit Sub For Each cell2 In sht2.Columns(1).Cells If cell2.Value = cell1.Value Then cell1.Interior.ColorIndex = 3 cell2.Interior.ColorIndex = 3 End If Next cell2 Next cell1 End Sub |
|
#5
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
|
Please help with a "find duplicates" macro - 4/10/07
Rodrigo, I do thank you for you help.
I ran your macro but it came up with a "compile error" at this line If sht1.Cells(rowSht1, 1).Value = sht2.Cells(rowSht2, 1).Value Then "Rodrigo Ferreira" wrote: Look this code: Sub FindDupes() 'assuming both sheets are in same book and book is open Dim sht1 As Worksheet Dim sht2 As Worksheet Dim cell1 As Range Dim cell2 As Range Dim str As String 'str = InputBox("Type name of first sheet") str = "Plan1" Set sht1 = Worksheets(str) 'str = InputBox("Type name of second sheet") str2 = "Plan2" Set sht2 = Worksheets(str2) sht1.Range("A65536").End(xlDown).Activate Selection.End(xlUp).Activate LastRowSht1 = ActiveCell.Row sht2.Activate sht2.Range("A65536").End(xlDown).Activate Selection.End(xlUp).Activate LastRowSht2 = ActiveCell.Row sht1.Activate For rowSht1 = 1 To LastRowSht1 If sht1.Cells(rowSht1, 1) = "" Then Exit Sub For rowSht2 = 1 To LastRowSht2 If sht1.Cells(rowSht1, 1).Value = sht2.Cells(rowSht2, 1).Value Then sht1.Cells(rowSht1, 1).Interior.ColorIndex = 3 sht2.Cells(rowSht2, 1).Interior.ColorIndex = 3 sht1.Rows(rowSht1 & ":" & rowSht1).Delete Shift:=xlUp End If Next Next sht1.Cells(1, 1).Select End Sub -- Rodrigo Ferreira "41db14" escreveu na mensagem ... Hi Rodrigo, I edited the macro per your suggestion. The Macro stops and highlights in yellow the line...If cell2.Value = cell1.Value Then The error indicates it looking for a value? I ran the macro both with an without the comment indicator in front of the lines ' cell1.Interior.ColorIndex = 3 ' cell2.Interior.ColorIndex = 3 didn't seem to make any difference. Here is the entire macro with your suggested change Sub FindDupes() 'assuming both sheets are in same book and book is open Dim sht1 As Worksheet Dim sht2 As Worksheet Dim cell1 As Range Dim cell2 As Range Dim str As String str = InputBox("Type name of first sheet") Set sht1 = Worksheets(str) str = InputBox("Type name of second sheet") Set sht2 = Worksheets(str) For Each cell1 In sht1.Columns(1).Cells If cell1.Value = "" Then Exit Sub For Each cell2 In sht2.Columns(1).Cells If cell2.Value = cell1.Value Then ' cell1.Interior.ColorIndex = 3 ' cell2.Interior.ColorIndex = 3 sht1.Rows(cell1.Row & ":" & cell1.Row).Delete Shift:=xlUp End If Next cell2 Next cell1 End Sub ************************************************** ********* "Rodrigo Ferreira" wrote: Something like this: .... 'cell1.Interior.ColorIndex = 3 'cell2.Interior.ColorIndex = 3 sht1.Rows(cell1.Row & ":" & cell1.Row).Delete Shift:=xlUp .... -- Rodrigo Ferreira "41db14" escreveu na mensagem ... A while back someone was very helpful in solving a macro problem. I need a little more assistance. The macro compared "Column A" in two worksheets (Master & Sub) and identified the duplicates by changing the cell background to red.. When the macro encountered it's first blank cell in the Master sheet the macro stopped running. This Macro worked great. I still need to compare the two worksheets "Column A" but when the macro sees duplicates it needs to delete the entire row in the Master worksheet. Below is the Macro I have been using... I am not sure if this macro can be modified or need a complete new macro? Any assistance would be appreciated. Sub FindDupes() 'assuming both sheets are in same book and book is open Dim sht1 As Worksheet Dim sht2 As Worksheet Dim cell1 As Range Dim cell2 As Range Dim str As String str = InputBox("Type name of first sheet") Set sht1 = Worksheets(str) str = InputBox("Type name of second sheet") Set sht2 = Worksheets(str) For Each cell1 In sht1.Columns(1).Cells If cell1.Value = "" Then Exit Sub For Each cell2 In sht2.Columns(1).Cells If cell2.Value = cell1.Value Then cell1.Interior.ColorIndex = 3 cell2.Interior.ColorIndex = 3 End If Next cell2 Next cell1 End Sub |
|
#6
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
|
Please help with a "find duplicates" macro - 4/10/07
You have run into line-wrap.
Those two lines should be all one line or use a line continuation character (_) If sht1.Cells(rowSht1, 1).Value = sht2.Cells(rowSht2, 1).Value _ Then Gord Dibben MS Excel MVP On Wed, 11 Apr 2007 12:18:03 -0700, 41db14 wrote: Rodrigo, I do thank you for you help. I ran your macro but it came up with a "compile error" at this line If sht1.Cells(rowSht1, 1).Value = sht2.Cells(rowSht2, 1).Value Then "Rodrigo Ferreira" wrote: Look this code: Sub FindDupes() 'assuming both sheets are in same book and book is open Dim sht1 As Worksheet Dim sht2 As Worksheet Dim cell1 As Range Dim cell2 As Range Dim str As String 'str = InputBox("Type name of first sheet") str = "Plan1" Set sht1 = Worksheets(str) 'str = InputBox("Type name of second sheet") str2 = "Plan2" Set sht2 = Worksheets(str2) sht1.Range("A65536").End(xlDown).Activate Selection.End(xlUp).Activate LastRowSht1 = ActiveCell.Row sht2.Activate sht2.Range("A65536").End(xlDown).Activate Selection.End(xlUp).Activate LastRowSht2 = ActiveCell.Row sht1.Activate For rowSht1 = 1 To LastRowSht1 If sht1.Cells(rowSht1, 1) = "" Then Exit Sub For rowSht2 = 1 To LastRowSht2 If sht1.Cells(rowSht1, 1).Value = sht2.Cells(rowSht2, 1).Value Then sht1.Cells(rowSht1, 1).Interior.ColorIndex = 3 sht2.Cells(rowSht2, 1).Interior.ColorIndex = 3 sht1.Rows(rowSht1 & ":" & rowSht1).Delete Shift:=xlUp End If Next Next sht1.Cells(1, 1).Select End Sub -- Rodrigo Ferreira "41db14" escreveu na mensagem ... Hi Rodrigo, I edited the macro per your suggestion. The Macro stops and highlights in yellow the line...If cell2.Value = cell1.Value Then The error indicates it looking for a value? I ran the macro both with an without the comment indicator in front of the lines ' cell1.Interior.ColorIndex = 3 ' cell2.Interior.ColorIndex = 3 didn't seem to make any difference. Here is the entire macro with your suggested change Sub FindDupes() 'assuming both sheets are in same book and book is open Dim sht1 As Worksheet Dim sht2 As Worksheet Dim cell1 As Range Dim cell2 As Range Dim str As String str = InputBox("Type name of first sheet") Set sht1 = Worksheets(str) str = InputBox("Type name of second sheet") Set sht2 = Worksheets(str) For Each cell1 In sht1.Columns(1).Cells If cell1.Value = "" Then Exit Sub For Each cell2 In sht2.Columns(1).Cells If cell2.Value = cell1.Value Then ' cell1.Interior.ColorIndex = 3 ' cell2.Interior.ColorIndex = 3 sht1.Rows(cell1.Row & ":" & cell1.Row).Delete Shift:=xlUp End If Next cell2 Next cell1 End Sub ************************************************** ********* "Rodrigo Ferreira" wrote: Something like this: .... 'cell1.Interior.ColorIndex = 3 'cell2.Interior.ColorIndex = 3 sht1.Rows(cell1.Row & ":" & cell1.Row).Delete Shift:=xlUp .... -- Rodrigo Ferreira "41db14" escreveu na mensagem ... A while back someone was very helpful in solving a macro problem. I need a little more assistance. The macro compared "Column A" in two worksheets (Master & Sub) and identified the duplicates by changing the cell background to red.. When the macro encountered it's first blank cell in the Master sheet the macro stopped running. This Macro worked great. I still need to compare the two worksheets "Column A" but when the macro sees duplicates it needs to delete the entire row in the Master worksheet. Below is the Macro I have been using... I am not sure if this macro can be modified or need a complete new macro? Any assistance would be appreciated. Sub FindDupes() 'assuming both sheets are in same book and book is open Dim sht1 As Worksheet Dim sht2 As Worksheet Dim cell1 As Range Dim cell2 As Range Dim str As String str = InputBox("Type name of first sheet") Set sht1 = Worksheets(str) str = InputBox("Type name of second sheet") Set sht2 = Worksheets(str) For Each cell1 In sht1.Columns(1).Cells If cell1.Value = "" Then Exit Sub For Each cell2 In sht2.Columns(1).Cells If cell2.Value = cell1.Value Then cell1.Interior.ColorIndex = 3 cell2.Interior.ColorIndex = 3 End If Next cell2 Next cell1 End Sub |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| How to change the default in Excel from "find next" to "find all" | Excel Discussion (Misc queries) | |||
| SUMPRODUCT(--ISNUMBER(FIND("AM",C5:160))*(k5:k160="") | Excel Discussion (Misc queries) | |||
| Macro to concatenate into "B1" B2 thru B"x" based on new data in "Col A" | Excel Discussion (Misc queries) | |||
| HELP on "left","right","find","len","substitute" functions | Excel Discussion (Misc queries) | |||
| Macro to find copy "header" and paste | Excel Discussion (Misc queries) | |||
Hybrid Mode
