Solved: Copy Unique Row(s) From One Sheet to Another

[jdubya]

Hi,

Just discovered this site recently, and I?m impressed with the amount of good information that can be found.

I would like to perform a web query and import the latest share prices of ten funds into a worksheet (Thrift Savings Plan - 401K plan for government workers).

I?m thinking that the best approach would be to set up two worksheets: one for setting up the web query, and the other worksheet would keep the historical data, but I?m lost in how new share prices can be copied over and appended to the historical data sheet automatically without duplicates.

Spreadsheet is attached (tspwebquery.xls).

Program Version: Microsoft Excel 2003 (Version 11, Build 5612)

I appreciate any help!

[lucas]

Why not delete the old data and then copy the the new data to that sheet?

[lucas]

If you wish to keep the history you can delete duplicate rows based on the date column or column A using the following routine:
[VBA]Sub DeleteDups()

Dim x As Long
Dim LastRow As Long

LastRow = Range("A65536").End(xlUp).Row
For x = LastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("A1:A" & x), Range("A" & x).Text) > 1 Then
Range("A" & x).EntireRow.Delete
End If
Next x

End Sub[/VBA]

[lucas]

this will copy the data to the data sheet and then delete all rows(in the data sheet) that have duplicate info in Col A except 1...
[vba]
Option Explicit
Sub CopyAndRemoveDups()
Dim cl As Range
Dim ws As Worksheet
Dim x As Long
Dim LastRow As Long
Dim rng As Range
Dim rngToDelete As Range


Set ws = Worksheets("query")
With ws

For Each cl In .Range("A2:A" & .Range("A65536").End(xlUp).Row)
If cl.Value <> "" Then
cl.EntireRow.Copy Worksheets("data").Range("A65536").End(xlUp).Offset(1, 0)
End If
Next cl
End With

Set ws = Worksheets("data")
'Advanced Filter requires a header row - let's add a temporary one
ws.Rows(1).Insert
ws.Cells(1, 1).Value = "temp header"

Set rng = ws.Range("A1:A10000")
rng.AdvancedFilter xlFilterInPlace, unique:=True
Set rngToDelete = rng.SpecialCells(xlCellTypeVisible)
ws.ShowAllData
rngToDelete.EntireRow.Hidden = True
rng.SpecialCells(xlCellTypeVisible).EntireRow.Delete
rngToDelete.EntireRow.Hidden = False

'remove the temporary row
ws.Rows(1).Delete
End Sub[/vba]

see attached....add data to the query sheet to see this work as all of the info you now have in the query sheet is a duplicate except the row 31-Oct-06.

[jdubya]

this will copy the data to the data sheet and then delete all rows(in the data sheet) that have duplicate info in Col A except 1...
[vba]
Option Explicit
Sub CopyAndRemoveDups()
Dim cl As Range
Dim ws As Worksheet
Dim x As Long
Dim LastRow As Long
Dim rng As Range
Dim rngToDelete As Range


Set ws = Worksheets("query")
With ws

For Each cl In .Range("A2:A" & .Range("A65536").End(xlUp).Row)
If cl.Value <> "" Then
cl.EntireRow.Copy Worksheets("data").Range("A65536").End(xlUp).Offset(1, 0)
End If
Next cl
End With

Set ws = Worksheets("data")
'Advanced Filter requires a header row - let's add a temporary one
ws.Rows(1).Insert
ws.Cells(1, 1).Value = "temp header"

Set rng = ws.Range("A1:A10000")
rng.AdvancedFilter xlFilterInPlace, unique:=True
Set rngToDelete = rng.SpecialCells(xlCellTypeVisible)
ws.ShowAllData
rngToDelete.EntireRow.Hidden = True
rng.SpecialCells(xlCellTypeVisible).EntireRow.Delete
rngToDelete.EntireRow.Hidden = False

'remove the temporary row
ws.Rows(1).Delete
End Sub[/vba]
see attached....add data to the query sheet to see this work as all of the info you now have in the query sheet is a duplicate except the row 31-Oct-06.

Steve,

I've tried it, and it looks like this is what I want it to do!

Thanks for your assistance!

Jon

[lucas]

Glad to help Jon, be sure to mark your thread solved using the thread tools at the top of the page. If you have more questions be sure to post them. Just because you mark it solved doesn't mean its closed.