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.

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.

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.

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.

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.

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.