Get distinct rows from different worksheets into another worksheet

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

I have data in some sheets (the same data can be repeated in different
sheets)..I want to compile distinct records from these worksheets into
another sheet...prefereably using vba code.

I do not want to use a formula...since once i get the distinct data...i want
to use vlookup to get sales figures and then sort the data on sales...

I also want that the data automatically gets sorted in the compiled sheet in
desc order.

Plz help.

Nikhil
 
Data=>Filter=>Advanced filter has the option of getting a list of unique
values.

It is also supported by VBA code.

I turned on the macro recorder and executed the actions manually, and got
this:

Sub Macro1()
Range("A1:A56").Select
Application.CutCopyMode = False
Range("A1:A56").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("G1"), _
Unique:=True
Range("G1").Select
Selection.Sort Key1:=Range("G2"), _
Order1:=xlAscending, _
Header:=xlGuess, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom
End Sub

You should be able to generalize it to do what you want. You can copy to
another sheet.
 
Thanks for the help... But let me clarify....

the data is not in 1 column...i want to copy distinct rows of data.....

e.g. i have three (or more) sheets

Sheet1 -

A B C D
1 2 3 4
5 6 7 8
5 6 7 8

and sheet2 -

A B C D
8 9 10 11
5 6 7 8
12 13 14 15

the result i want to compile in say sheet3 should be

A B C D
1 2 3 4
5 6 7 8
8 9 10 11
12 13 14 15

thereafter using vlookup i can get the sales figure in col E....
now i would like the data in sheet3 to automatically get sorted on the
sales figures in col E.

Plz note that i would be adding data to new sheets...all of which should be
compiled in sheet3

any of the column in sheet 1 or 2 might contain a blank cell

Hope you could help me yet again...

Regards

Nikhil
 
Sub Macro1()
Dim bHeader as Boolean, sh1 as Worksheet
Dim sh as Worksheet, rng as Range, rng1 as Range
Dim rng2 as Range
set sh1 = Worksheets("Summary")
sh1.Cells.ClearContents
for each sh in Worksheets
if lcase sh.Name <> "summary" then
set rng = sh.range(.cells(1,1),.cells(rows.count,1).End(xlup))
set rng1 = rng.Resize(,4)
set rng2 = sh1.cells(rows.count,1).End(xlup)(2)
rng1.AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=rng2, _
Unique:=True
end if
if not bHeader then
rng2.EntireRow.Delete
bHeader = true
end if
Next
set rng = sh1.range(.cells(2,1),.cells(rows.count,1).End(xlup))
set rng1 = rng.Resize(,4)
set rng2 = sh1.Range("E2")
rng1.AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=rng2, _
Unique:=True
sh1.Range("A1").EntireColumn.Resize(,4).Delete
End Sub


Then in Sheet Summary's code module

Private Sub Application.Calculate()
if not isempty(me.Range("A1")) then
sh1.Cells.Sort Key1:=Range("E2"), _
Order1:=xlAscending, _
Header:=xlGuess, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom
end if
End Sub
 
Thanks once again..... however i am getting an error

the error occurs on line -

if lcase sh.Name <> "summary" then

another error which occurs when i copy the second set of module function in
summary sheet.. that occurs on the first line...

Private Sub Application.Calculate()

May i also mention that i would not like to copy data from all the
worksheetss..but some selected 12 worksheets of a total of 15 worksheets to
the summary sheet.

Appreciate your help once again.

Nikhil
 
Thanks once again..... however i am getting an error

the error occurs on line -

if lcase sh.Name <> "summary" then

another error which occurs when i copy the second set of module function in
summary sheet.. that occurs on the first line...

Private Sub Application.Calculate()

May i also mention that i would not like to copy data from all the
worksheetss..but some selected 12 worksheets of a total of 15 worksheets to
the summary sheet.

Appreciate your help once again.

Nikhil
 
if lcase(sh.Name) <> "summary" then


Private Sub Worksheet_Calculate()

Adjust the code to process the sheets you want. (or exclude those you don't)
 
Hi...

Sir, I guess I still need your help....!!

I did copy the code but it gives an error....
at the line...

set rng = sh.range(.cells(1,1),.cells(rows.count,1).End(xlup))

the error message is : Compile Error. Invalid or unqualified reference

Plz help... I am not conversant with VB coding in Excel...therefore request
you to plz help me execute the code.

Nikhil
 
Try:

set rng = sh.range(sh.cells(1,1),sh.cells(rows.count,1).End(xlup))

And it looks like you may have to fix this line, too:

set rng = sh1.range(sh1.cells(2,1),sh1.cells(rows.count,1).End(xlup))
 
Back
Top