Exporting specific rows in another Sheet

  • Thread starter Thread starter MS Excel
  • Start date Start date
M

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


Rookie_User said:
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.
Click to expand...
 
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:o" & 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("p1:p2"), _
CopyToRange:=wsNew.Range("A1"), _
Unique:=False
Next c
.Select
.Columns("o:p").Delete
End With
End Sub

Rookie_User said:
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.
Click to expand...
 
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.
 
Back
Top