Exporting specific rows in another Sheet

[MS Excel]

Hi all,

Got a prbolem...
I have to download a data through some sysmtem having 1000 of rows of
different customer on sheet "customer". Each customer has specific account
ID however have multiple transactions. now I want a simple procedure to
extract / call specific customer's row wise detail on other sheet just by
entering his account number..? like

Sheet "Customer"
A B C D
1 A/c # Name Currency Amount
2 001 MR. A USD 500
3 001 MR. A USD 125
4 002 MR. B EUR 500
5 001 MR. A GBP 75

On another sheet "Statement of Account"

I want to type CUTOMER A/C NO : 001 and all transaction of this customer are
shown in here as

2 001 MR. A USD 500
3 001 MR. A USD 125
5 001 MR. A GBP 75

Sorry, but another thing If possible can you adivse a way to pick up (as a
list of accounts) a/c #, Cust. Name & currency in some sort of combo box? I
know the best way is "Filter" but is there any other way? Thanks for your
support .

 

[Dave Peterson]

Why not just create a new worksheet for each account number and remove the
choice. You could use some code taken from Debra Dalgleish's site or Ron de
Bruin's:

Debra's site:
http://www.contextures.com/excelfiles.html

Create New Sheets from Filtered List -- uses an Advanced Filter to create
separate sheet of orders for each sales rep visible in a filtered list; macro
automates the filter. AdvFilterRepFiltered.xls 35 kb

or

Update Sheets from Master -- uses an Advanced Filter to send data from
Master sheet to individual worksheets -- replaces old data with current.
AdvFilterCity.xls 55 kb

Ron de Bruin's easyfilter.
http://www.rondebruin.nl/easyfilter.htm

 

[Guest]

Dave, in an effort to provide information quickly I have a worksheet that has
several rows, there is a column of names, and the names are repeated down the
column, if I want to copy the entire row with the columns A:M and have all
the same names on one worksheet and when the name changes, it then starts
another worksheet, but it copies all the columns not just the first column.
I was trying to use easy filter and for some reason I can't get this result.

 

[Dave Peterson]

I'm confused. Do you want to copy A:M of that row or just the first column--and
is the first column column A?

And I'm confused about what you're using.

You may want to post the code you're using.

 

[Guest]

My apologies - as I am in a panic mode.

My "sheet1" is the source worksheet and it has about 500 rows. the columns
from A to M are occupied. An example below.

A---->M
order date Rep price unit ETC.
1 x Ralph 6.00 5 etc.
2 x Ralph 8.00 5 etc.
3 x Ted 1.00 5 etc.
4 x Ted 11.00 5 etc.
5 z Ralph 6.00 5 etc.
6 y Jason 6.00 5 etc.

The worksheets will be named: Ralph(with all three rows of data), Ted(with
two rows of data, Jason(one row of data)
I am not showing all the headers for A:M columns, but I have more. I went
to use easyfilter from a website that I can't figure out. So the code I am
now working with is:

Option Explicit

Sub ExtractReps()
Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range
Dim r As Integer
Dim c As Range
Set ws1 = Sheets("Sheet1")
Set rng = Range("Database")

'extract a list of Sales Reps
ws1.Columns("C:C").Copy _
Destination:=Range("O1")
ws1.Columns("O:O").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("M1"), Unique:=True
r = Cells(Rows.Count, "L").End(xlUp).Row

'set up Criteria Area
Range("O1").Value = Range("C1").Value

For Each c In Range("L2:L" & r)
'add the rep name to the criteria area
ws1.Range("O2").Value = c.Value
'add new sheet (if required)
'and run advanced filter
If WksExists(c.Value) Then
Sheets(c.Value).Cells.Clear
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Sheet1").Range("O1:O2"), _
CopyToRange:=Sheets(c.Value).Range("A1"), _
Unique:=False
Else
Set wsNew = Sheets.Add
wsNew.Move After:=Worksheets(Worksheets.Count)
wsNew.Name = c.Value
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Sheet1").Range("O1:O2"), _
CopyToRange:=wsNew.Range("A1"), _
Unique:=False
End If
Next
ws1.Select
ws1.Columns("L:O").Delete
End Sub
Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function


I sometimes get an error on the first declaration statement of
rng=("database") or something like that. But the real problem is it only
compies columns A thru G. But it does create all the worksheets, but it
stops including the data after the third for fourth one. Any help is
appreciated.

 

[Ron de Bruin]

Use this one

I only change the column number to 3


Sub Copy_With_AdvancedFilter_To_Worksheets()
Dim CalcMode As Long
Dim ws1 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim cell As Range
Dim Lrow As Long

Set ws1 = Sheets("Sheet1") '<<< Change
Set rng = ws1.Range("A1").CurrentRegion '<<< Change

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

With ws1
rng.Columns(3).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("IV1"), Unique:=True
'This example filter on the first column in the range (change this if needed)
'You see that the last two columns of the worksheet are used to make a Unique list
'and add the CriteriaRange.(you can't use this macro if you use the columns)

Lrow = .Cells(Rows.Count, "IV").End(xlUp).Row
.Range("IU1").Value = .Range("IV1").Value

For Each cell In .Range("IV2:IV" & Lrow)
.Range("IU2").Value = cell.Value
Set WSNew = Sheets.Add
On Error Resume Next
WSNew.Name = cell.Value
If Err.Number > 0 Then
MsgBox "Change the name of : " & WSNew.Name & " manually"
Err.Clear
End If
On Error GoTo 0
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("IU1:IU2"), _
CopyToRange:=WSNew.Range("A1"), _
Unique:=False
WSNew.Columns.AutoFit
Next
.Columns("IU:IV").Clear
End With

With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub

--
Regards Ron de Bruin
http://www.rondebruin.nl

My apologies - as I am in a panic mode.

My "sheet1" is the source worksheet and it has about 500 rows. the columns
from A to M are occupied. An example below.

A---->M
order date Rep price unit ETC.
1 x Ralph 6.00 5 etc.
2 x Ralph 8.00 5 etc.
3 x Ted 1.00 5 etc.
4 x Ted 11.00 5 etc.
5 z Ralph 6.00 5 etc.
6 y Jason 6.00 5 etc.

The worksheets will be named: Ralph(with all three rows of data), Ted(with
two rows of data, Jason(one row of data)
I am not showing all the headers for A:M columns, but I have more. I went
to use easyfilter from a website that I can't figure out. So the code I am
now working with is:

Option Explicit

Sub ExtractReps()
Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range
Dim r As Integer
Dim c As Range
Set ws1 = Sheets("Sheet1")
Set rng = Range("Database")

'extract a list of Sales Reps
ws1.Columns("C:C").Copy _
Destination:=Range("O1")
ws1.Columns("O:O").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("M1"), Unique:=True
r = Cells(Rows.Count, "L").End(xlUp).Row

'set up Criteria Area
Range("O1").Value = Range("C1").Value

For Each c In Range("L2:L" & r)
'add the rep name to the criteria area
ws1.Range("O2").Value = c.Value
'add new sheet (if required)
'and run advanced filter
If WksExists(c.Value) Then
Sheets(c.Value).Cells.Clear
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Sheet1").Range("O1:O2"), _
CopyToRange:=Sheets(c.Value).Range("A1"), _
Unique:=False
Else
Set wsNew = Sheets.Add
wsNew.Move After:=Worksheets(Worksheets.Count)
wsNew.Name = c.Value
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Sheet1").Range("O1:O2"), _
CopyToRange:=wsNew.Range("A1"), _
Unique:=False
End If
Next
ws1.Select
ws1.Columns("L:O").Delete
End Sub
Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function


I sometimes get an error on the first declaration statement of
rng=("database") or something like that. But the real problem is it only
compies columns A thru G. But it does create all the worksheets, but it
stops including the data after the third for fourth one. Any help is
appreciated.

 

[Ron de Bruin]

I see that you used the other example from my site.
Only change the column number in that macro to

http://www.rondebruin.nl/copy5.htm#existing

 

[Dave Peterson]

Can you use column C to determine the last row of the data?

If yes, then maybe this will be closer--I added a couple of checks, too:

Option Explicit
Sub ExtractReps2()
Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range
Dim r As Integer
Dim c As Range

Set ws1 = Sheets("Sheet1")

With ws1
Set rng = .Range("A1:M" & .Cells(.Rows.Count, "C").End(xlUp).Row)

.Range("C:C").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("O1"), Unique:=True

r = .Cells(.Rows.Count, "o").End(xlUp).Row

'set up Criteria Area
.Range("P1").Value = Range("c1").Value

For Each c In .Range("o2" & r)
'add the rep name to the criteria area
.Range("p2").Formula = "=" & """=" & c.Value & """"

'add new sheet and run advanced filter
'delete old sheet
Application.DisplayAlerts = False
On Error Resume Next
Worksheets(c.Value).Delete
On Error GoTo 0
Application.DisplayAlerts = True

Set wsNew = Sheets.Add
wsNew.Move After:=Worksheets(Worksheets.Count)
On Error Resume Next
wsNew.Name = c.Value
If Err.Number <> 0 Then
MsgBox "Please rename: " & wsNew.Name & vbLf _
& "An error occurred while renaming."
Err.Clear
End If
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("p12"), _
CopyToRange:=wsNew.Range("A1"), _
Unique:=False
Next c
.Select
.Columns("o").Delete
End With
End Sub

My apologies - as I am in a panic mode.

My "sheet1" is the source worksheet and it has about 500 rows. the columns
from A to M are occupied. An example below.

A---->M
order date Rep price unit ETC.
1 x Ralph 6.00 5 etc.
2 x Ralph 8.00 5 etc.
3 x Ted 1.00 5 etc.
4 x Ted 11.00 5 etc.
5 z Ralph 6.00 5 etc.
6 y Jason 6.00 5 etc.

The worksheets will be named: Ralph(with all three rows of data), Ted(with
two rows of data, Jason(one row of data)
I am not showing all the headers for A:M columns, but I have more. I went
to use easyfilter from a website that I can't figure out. So the code I am
now working with is:

Option Explicit

Sub ExtractReps()
Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range
Dim r As Integer
Dim c As Range
Set ws1 = Sheets("Sheet1")
Set rng = Range("Database")

'extract a list of Sales Reps
ws1.Columns("C:C").Copy _
Destination:=Range("O1")
ws1.Columns("O:O").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("M1"), Unique:=True
r = Cells(Rows.Count, "L").End(xlUp).Row

'set up Criteria Area
Range("O1").Value = Range("C1").Value

For Each c In Range("L2:L" & r)
'add the rep name to the criteria area
ws1.Range("O2").Value = c.Value
'add new sheet (if required)
'and run advanced filter
If WksExists(c.Value) Then
Sheets(c.Value).Cells.Clear
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Sheet1").Range("O1:O2"), _
CopyToRange:=Sheets(c.Value).Range("A1"), _
Unique:=False
Else
Set wsNew = Sheets.Add
wsNew.Move After:=Worksheets(Worksheets.Count)
wsNew.Name = c.Value
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Sheet1").Range("O1:O2"), _
CopyToRange:=wsNew.Range("A1"), _
Unique:=False
End If
Next
ws1.Select
ws1.Columns("L:O").Delete
End Sub
Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function

I sometimes get an error on the first declaration statement of
rng=("database") or something like that. But the real problem is it only
compies columns A thru G. But it does create all the worksheets, but it
stops including the data after the third for fourth one. Any help is
appreciated.

 

[Guest]

Ron de Bruin's, GUILTY AS CHARGED - yes your site is awesome, purely awesome.
I discovered something else why it was not copying anything beyond column
"G" and it was only copying 43 rows -- because "database" was a named range
of those values. It works now but I get an error at the very end - I don't
remember right now. But I will also use your suggestion and the one from
Dave Peterson. You guys are truly a lifesaver - especially when it the
subjects says "hurry" your responses are well appreciated. The more I learn
from your sites the better. I will report back on success.