Get distinct rows from different worksheets into another worksheet

[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

 

[Tom Ogilvy]

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.

 

[Guest]

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

 

[Tom Ogilvy]

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

 

[Guest]

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

 

[Guest]

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

 

[Tom Ogilvy]

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)

 

[Guest]

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

 

[Dave Peterson]

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))