Merge Data from 2 lists into 1 without duplicates

[jwpiii]

New to VBA and new to vbaexpress.com so please be kind!!!

Our company uses a piece of software that will generate reports in an Excel format. I am generating two different reports that have the same format but different data. when the reports are generated the system creates a unique name each time. I am copying the data using Paste Special (Values) to two different sheets in the same workbook. The first sheet is named Female and the second is named Male. I need to consolidate Female and Male into a master list named Treatment Prices without duplicates. I can copy all of Female to Treatment Prices and then would like to compare Male and append those rows that are not present to the end of Treatment Prices. Then when finished appending I would like to resort the list.

Column b is the Description which is unique to the list. and column F contains the price that I need in the consolidated list as well.

The range always starts on row 10 and the ending range will vary. The description "TREATMENT TOTAL" is always present in Column B 2 rows after the last item.

I assume that the routine would calculate the range of items for Female and copy columns B and F to Treatment Prices. Then it would look at each item in Male and look to see if it is present on Treatment Prices. If it is it would continnue to the next item, if not it would add a new item containing the description and the price to Treatment Prices and search again. When finished appending items, the list would be resorted in ascending order.

Hope this makes sense and Thanks in advance for your help.

John

[lucas]

Try this John...best I can do without seeing your spreadsheet. Change the names of the sheets to match yours. this will combine the first sheet with the second and removed duplicates and sort all starting at row 10:
[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("B10:B" & .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("A10: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
'sort
Range("A10:K600").Select
Selection.Sort Key1:=Range("A10"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Select
End Sub[/VBA]

[jwpiii]

Steve,

Wow, that was fast. I spent the last two days trying my best to figure out how to accomplish it within Excel in the absence of VBA. I look forward to working with your code to gain an understanding of how you are accomplishing it.

Thanks again and I'm sure I'll have a question or two about it!!!!

John

[lucas]

No problem John....mostly stuff I put together from real coders here at the forum. If that worked you can mark your thread solved using thread tools at the top of the page. You can still post followup questions at any time.