Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 6
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 6,953
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 6
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 6,953
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 6
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 159
Default 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
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Compare worksheets for duplicates and copy data to 1st worksheet Monique Excel Worksheet Functions 2 September 12th 07 07:50 PM
Find Duplicates and Move to New Worksheet Adurr Excel Worksheet Functions 9 June 28th 07 02:48 AM
how do i find and delete duplicates in excel worksheet? mrsthickness Excel Discussion (Misc queries) 2 February 28th 06 08:57 PM
why can't excel do a simple find and copy row from a worksheet to. rasman Excel Worksheet Functions 2 December 28th 04 05:49 PM
Auto find a specific row and copy it to another worksheet hme Excel Programming 1 November 1st 04 02:29 PM


All times are GMT +1. The time now is 08:07 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"