Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find and copy duplicates to new worksheet
Hi,
I have a macro to find and mark duplicated values in a sorted column of data as follows: Sub FindDuplicates() Dim check As String Dim colName As String Dim A As Integer colName = "B" Range(colName & 1).Select 'loop through first 100 rows For A = 1 To 100 Range(colName & A).Activate If ActiveCell.Value = check Then ActiveCell.Font.Bold = True Else End If check = ActiveCell.Value Next A End Sub I'd like to copy the values from the marked cells (and also the matching value from the cell above, if possible) to a new worksheet. I can get the first hit okay by adding this code to the loop: ActiveCell.EntireRow.Copy Sheets(2).Select ActiveSheet.Paste .... but this breaks things - presumably because I lose the active cell? Any suggestions on how I should approach this? many thanks, Del. |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find and copy duplicates to new worksheet
the way to speed up your code and avoid these situations is to resist using
selection, select, and activecell. They are usually not necessary. Change colNum to point to the column you want to check for duplicates Sub FindDuplicates() Dim colNum as String Dim rng as range, cell as Range Dim rng1 as Range colNum = "A" With Activesheet set rng = .Range(.Cells(1,colNum), _ .Cells(rows.count,colNum).End(xlup)) End With for each cell in rng if application.Countif(rng,cell) 1 then if rng1 is nothing then set rng1 = cell else set rng1 = Union(rng1,cell) end if end if Next If not rng1 is nothing then rng1.entireRow.Copy Sheets(2).Range("A1") End if End Sub the code worked fine for me. It should be placed in a General Module (in the VBE, Insert=Module). It processes the activesheet when you run it. -- Regards, Tom Ogilvy "Del_F" wrote: Hi, I have a macro to find and mark duplicated values in a sorted column of data as follows: Sub FindDuplicates() Dim check As String Dim colName As String Dim A As Integer colName = "B" Range(colName & 1).Select 'loop through first 100 rows For A = 1 To 100 Range(colName & A).Activate If ActiveCell.Value = check Then ActiveCell.Font.Bold = True Else End If check = ActiveCell.Value Next A End Sub I'd like to copy the values from the marked cells (and also the matching value from the cell above, if possible) to a new worksheet. I can get the first hit okay by adding this code to the loop: ActiveCell.EntireRow.Copy Sheets(2).Select ActiveSheet.Paste .... but this breaks things - presumably because I lose the active cell? Any suggestions on how I should approach this? many thanks, Del. |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find and copy duplicates to new worksheet
okay, made some progress:
Sub FindDuplicates() Dim check As String Dim colName As String Dim A As Integer Dim count As Integer colName = "B" count = 1 Range(colName & 1).Select 'loop through first 100 rows For A = 1 To 100 Range(colName & A).Activate If ActiveCell.Value = check Then ActiveCell.Font.Bold = True ActiveCell.EntireRow.Copy Destination:=Worksheets("Sheet2").Cells(count, 1) count = count + 1 Else End If check = ActiveCell.Value Next A End Sub Any tips on how to copy both the matched row and the row above (i.e. the source of the 'check' value) would be welcome! Many thanks. On 2 Oct, 13:53, Del_F wrote: Hi, I have a macro to find and mark duplicated values in a sorted column of data as follows: Sub FindDuplicates() Dim check As String Dim colName As String Dim A As Integer colName = "B" Range(colName & 1).Select 'loop through first 100 rows For A = 1 To 100 Range(colName & A).Activate If ActiveCell.Value = check Then ActiveCell.Font.Bold = True Else End If check = ActiveCell.Value Next A End Sub I'd like to copy the values from the marked cells (and also the matching value from the cell above, if possible) to a new worksheet. I can get the first hit okay by adding this code to the loop: ActiveCell.EntireRow.Copy Sheets(2).Select ActiveSheet.Paste ... but this breaks things - presumably because I lose the active cell? Any suggestions on how I should approach this? many thanks, Del. |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find and copy duplicates to new worksheet
A solution has been offered. Is there a problem.
-- Regards, Tom Ogilvy "Del_F" wrote: okay, made some progress: Sub FindDuplicates() Dim check As String Dim colName As String Dim A As Integer Dim count As Integer colName = "B" count = 1 Range(colName & 1).Select 'loop through first 100 rows For A = 1 To 100 Range(colName & A).Activate If ActiveCell.Value = check Then ActiveCell.Font.Bold = True ActiveCell.EntireRow.Copy Destination:=Worksheets("Sheet2").Cells(count, 1) count = count + 1 Else End If check = ActiveCell.Value Next A End Sub Any tips on how to copy both the matched row and the row above (i.e. the source of the 'check' value) would be welcome! Many thanks. On 2 Oct, 13:53, Del_F wrote: Hi, I have a macro to find and mark duplicated values in a sorted column of data as follows: Sub FindDuplicates() Dim check As String Dim colName As String Dim A As Integer colName = "B" Range(colName & 1).Select 'loop through first 100 rows For A = 1 To 100 Range(colName & A).Activate If ActiveCell.Value = check Then ActiveCell.Font.Bold = True Else End If check = ActiveCell.Value Next A End Sub I'd like to copy the values from the marked cells (and also the matching value from the cell above, if possible) to a new worksheet. I can get the first hit okay by adding this code to the loop: ActiveCell.EntireRow.Copy Sheets(2).Select ActiveSheet.Paste ... but this breaks things - presumably because I lose the active cell? Any suggestions on how I should approach this? many thanks, Del. |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find and copy duplicates to new worksheet
Hi Tom,
Your solution works nicely; many thanks. Thanks also for the coding tips - duly noted! Del. On Oct 2, 3:05 pm, Tom Ogilvy wrote: A solution has been offered. Is there a problem. -- Regards, Tom Ogilvy "Del_F" wrote: okay, made some progress: Sub FindDuplicates() Dim check As String Dim colName As String Dim A As Integer Dim count As Integer colName = "B" count = 1 Range(colName & 1).Select 'loop through first 100 rows For A = 1 To 100 Range(colName & A).Activate If ActiveCell.Value = check Then ActiveCell.Font.Bold = True ActiveCell.EntireRow.Copy Destination:=Worksheets("Sheet2").Cells(count, 1) count = count + 1 Else End If check = ActiveCell.Value Next A End Sub Any tips on how to copy both the matched row and the row above (i.e. the source of the 'check' value) would be welcome! Many thanks. On 2 Oct, 13:53, Del_F wrote: Hi, I have a macro to find and mark duplicated values in a sorted column of data as follows: Sub FindDuplicates() Dim check As String Dim colName As String Dim A As Integer colName = "B" Range(colName & 1).Select 'loop through first 100 rows For A = 1 To 100 Range(colName & A).Activate If ActiveCell.Value = check Then ActiveCell.Font.Bold = True Else End If check = ActiveCell.Value Next A End Sub I'd like to copy the values from the marked cells (and also the matching value from the cell above, if possible) to a new worksheet. I can get the first hit okay by adding this code to the loop: ActiveCell.EntireRow.Copy Sheets(2).Select ActiveSheet.Paste ... but this breaks things - presumably because I lose the active cell? Any suggestions on how I should approach this? many thanks, Del. |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Find and copy duplicates to new worksheet
Hi Tom,
I have a question in regards to the code you posted on finding duplicates? What would be the best way make the sub use whats in a combobox. In other words have it search say column 'A' for say 'dog' from the combox selection list? "Del_F" wrote: Hi Tom, Your solution works nicely; many thanks. Thanks also for the coding tips - duly noted! Del. On Oct 2, 3:05 pm, Tom Ogilvy wrote: A solution has been offered. Is there a problem. -- Regards, Tom Ogilvy "Del_F" wrote: okay, made some progress: Sub FindDuplicates() Dim check As String Dim colName As String Dim A As Integer Dim count As Integer colName = "B" count = 1 Range(colName & 1).Select 'loop through first 100 rows For A = 1 To 100 Range(colName & A).Activate If ActiveCell.Value = check Then ActiveCell.Font.Bold = True ActiveCell.EntireRow.Copy Destination:=Worksheets("Sheet2").Cells(count, 1) count = count + 1 Else End If check = ActiveCell.Value Next A End Sub Any tips on how to copy both the matched row and the row above (i.e. the source of the 'check' value) would be welcome! Many thanks. On 2 Oct, 13:53, Del_F wrote: Hi, I have a macro to find and mark duplicated values in a sorted column of data as follows: Sub FindDuplicates() Dim check As String Dim colName As String Dim A As Integer colName = "B" Range(colName & 1).Select 'loop through first 100 rows For A = 1 To 100 Range(colName & A).Activate If ActiveCell.Value = check Then ActiveCell.Font.Bold = True Else End If check = ActiveCell.Value Next A End Sub I'd like to copy the values from the marked cells (and also the matching value from the cell above, if possible) to a new worksheet. I can get the first hit okay by adding this code to the loop: ActiveCell.EntireRow.Copy Sheets(2).Select ActiveSheet.Paste ... but this breaks things - presumably because I lose the active cell? Any suggestions on how I should approach this? many thanks, Del. |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Compare worksheets for duplicates and copy data to 1st worksheet | Excel Worksheet Functions | |||
Find Duplicates and Move to New Worksheet | Excel Worksheet Functions | |||
how do i find and delete duplicates in excel worksheet? | Excel Discussion (Misc queries) | |||
why can't excel do a simple find and copy row from a worksheet to. | Excel Worksheet Functions | |||
Auto find a specific row and copy it to another worksheet | Excel Programming |