PC Review


Reply
Thread Tools Rate Thread

Copy Data from one sheet to many based on column A

 
 
Steve
Guest
Posts: n/a
 
      21st Mar 2008
Hello everyone. I have a data sheet that 14,000 rows long. In column
A is the customer number. Then I have a "control" sheet, where I have
a list of customer numbers to pull (copy) from the data sheet
(A3:A20). Can VBA scan the data sheet, create a new sheet for all
entries in Control("A3:A20"), and copy in the entire row for every
instance found in the data sheet for each customer identified in
Control("A3:A20")?

I have some code below that looks at the data sheet, and based on the
value in column A creates a sheet for each unique instance and copies
the data in. Can this be modified to incorporate the list of values
in the Control sheet? Basically, The data sheet has over 300
customers in column A. I dont want to create 300 sheets! Only about
20, that will be in the list in Control("A1:A20"). Thanks!!

Sub ParseData()

Application.ScreenUpdating = False
With Sheets("Data")
lr = .Cells(Rows.Count, "a").End(xlUp).Row
.Range("A1:A" & lr).AdvancedFilter Action:=xlFilterInPlace,
Unique:=True
For Each c In .Range("a2:a" & lr).SpecialCells(xlVisible)
On Error Resume Next
If Worksheets(c.Value) Is Nothing Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = c
End If
.ShowAllData
.Range("a1:a" & lr).AutoFilter field:=1, Criteria1:=c
dlr = Sheets(c.Value).Cells(Rows.Count, "a").End(xlUp).Row + 1
.Range("a2:a" & lr).Copy Sheets(c.Value).Range("a" & dlr)
Next c
.ShowAllData
.Range("a1:a" & lr).AutoFilter
End With
Application.ScreenUpdating = True
Sheets("Data").Select

End Sub
 
Reply With Quote
 
 
 
 
Ron de Bruin
Guest
Posts: n/a
 
      21st Mar 2008
Try this one Steve
http://www.rondebruin.nl/copy5.htm#sheet

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Steve" <(E-Mail Removed)> wrote in message news:14d136fc-dbba-44bc-bd4b-(E-Mail Removed)...
> Hello everyone. I have a data sheet that 14,000 rows long. In column
> A is the customer number. Then I have a "control" sheet, where I have
> a list of customer numbers to pull (copy) from the data sheet
> (A3:A20). Can VBA scan the data sheet, create a new sheet for all
> entries in Control("A3:A20"), and copy in the entire row for every
> instance found in the data sheet for each customer identified in
> Control("A3:A20")?
>
> I have some code below that looks at the data sheet, and based on the
> value in column A creates a sheet for each unique instance and copies
> the data in. Can this be modified to incorporate the list of values
> in the Control sheet? Basically, The data sheet has over 300
> customers in column A. I dont want to create 300 sheets! Only about
> 20, that will be in the list in Control("A1:A20"). Thanks!!
>
> Sub ParseData()
>
> Application.ScreenUpdating = False
> With Sheets("Data")
> lr = .Cells(Rows.Count, "a").End(xlUp).Row
> .Range("A1:A" & lr).AdvancedFilter Action:=xlFilterInPlace,
> Unique:=True
> For Each c In .Range("a2:a" & lr).SpecialCells(xlVisible)
> On Error Resume Next
> If Worksheets(c.Value) Is Nothing Then
> Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = c
> End If
> .ShowAllData
> .Range("a1:a" & lr).AutoFilter field:=1, Criteria1:=c
> dlr = Sheets(c.Value).Cells(Rows.Count, "a").End(xlUp).Row + 1
> .Range("a2:a" & lr).Copy Sheets(c.Value).Range("a" & dlr)
> Next c
> .ShowAllData
> .Range("a1:a" & lr).AutoFilter
> End With
> Application.ScreenUpdating = True
> Sheets("Data").Select
>
> End Sub

 
Reply With Quote
 
Don Guillett
Guest
Posts: n/a
 
      21st Mar 2008
try this fired from the sheet with the list

Sub copydatatosheetforeach()
Set filtersht = Sheets("sheet2")
For Each c In Range("a3:a" & Cells(Rows.Count, "a").End(xlUp).Row)

With filtersht
lr = .Cells(Rows.Count, "a").End(xlUp).Row
..Range("a1:d" & lr).AutoFilter Field:=1, Criteria1:=c.Value
..Range("A2" & lr).SpecialCells(xlCellTypeVisible).Copy

Sheets.Add(After:=Sheets(Sheets.Count)).Name = c
ActiveSheet.Paste

..Range("a1:d" & lr).AutoFilter
End With
Next c
End Sub

--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(E-Mail Removed)
"Steve" <(E-Mail Removed)> wrote in message
news:14d136fc-dbba-44bc-bd4b-(E-Mail Removed)...
> Hello everyone. I have a data sheet that 14,000 rows long. In column
> A is the customer number. Then I have a "control" sheet, where I have
> a list of customer numbers to pull (copy) from the data sheet
> (A3:A20). Can VBA scan the data sheet, create a new sheet for all
> entries in Control("A3:A20"), and copy in the entire row for every
> instance found in the data sheet for each customer identified in
> Control("A3:A20")?
>
> I have some code below that looks at the data sheet, and based on the
> value in column A creates a sheet for each unique instance and copies
> the data in. Can this be modified to incorporate the list of values
> in the Control sheet? Basically, The data sheet has over 300
> customers in column A. I dont want to create 300 sheets! Only about
> 20, that will be in the list in Control("A1:A20"). Thanks!!
>
> Sub ParseData()
>
> Application.ScreenUpdating = False
> With Sheets("Data")
> lr = .Cells(Rows.Count, "a").End(xlUp).Row
> .Range("A1:A" & lr).AdvancedFilter Action:=xlFilterInPlace,
> Unique:=True
> For Each c In .Range("a2:a" & lr).SpecialCells(xlVisible)
> On Error Resume Next
> If Worksheets(c.Value) Is Nothing Then
> Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = c
> End If
> .ShowAllData
> .Range("a1:a" & lr).AutoFilter field:=1, Criteria1:=c
> dlr = Sheets(c.Value).Cells(Rows.Count, "a").End(xlUp).Row + 1
> .Range("a2:a" & lr).Copy Sheets(c.Value).Range("a" & dlr)
> Next c
> .ShowAllData
> .Range("a1:a" & lr).AutoFilter
> End With
> Application.ScreenUpdating = True
> Sheets("Data").Select
>
> End Sub


 
Reply With Quote
 
Steve
Guest
Posts: n/a
 
      21st Mar 2008
Thanks Ron! Is there a way to only create sheets and copy data for
specific values in column A? The number of unique values that I have
is about 300...I dont want to create 300 sheets! I'm really only
interested in copying out about 20 of the customers. I have the
customer numbers listed in a sheet called "control", range a1:a20. It
is also a named range called "customer". Thanks again for your help!!


On Mar 21, 10:12*am, "Ron de Bruin" <rondebr...@kabelfoon.nl> wrote:
> Try this one Stevehttp://www.rondebruin.nl/copy5.htm#sheet
>
> --
>
> Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm
>
>
>
> "Steve" <steve_andrus...@yahoo.com> wrote in messagenews:14d136fc-dbba-44bc-bd4b-(E-Mail Removed)...
> > Hello everyone. *I have a data sheet that 14,000 rows long. *In column
> > A is the customer number. *Then I have a "control" sheet, where I have
> > a list of customer numbers to pull (copy) from the data sheet
> > (A3:A20). Can VBA scan the data sheet, create a new sheet for all
> > entries in Control("A3:A20"), and copy in the entire row for every
> > instance found in the data sheet for each customer identified in
> > Control("A3:A20")?

>
> > I have some code below that looks at the data sheet, and based on the
> > value in column A creates a sheet for each unique instance and copies
> > the data in. *Can this be modified to incorporate the list of values
> > in the Control sheet? *Basically, The data sheet has over 300
> > customers in column A. *I dont want to create 300 sheets! *Only about
> > 20, that will be in the list in Control("A1:A20"). *Thanks!!

>
> > Sub ParseData()

>
> > Application.ScreenUpdating = False
> > With Sheets("Data")
> > lr = .Cells(Rows.Count, "a").End(xlUp).Row
> > *.Range("A1:A" & lr).AdvancedFilter Action:=xlFilterInPlace,
> > Unique:=True
> > For Each c In .Range("a2:a" & lr).SpecialCells(xlVisible)
> > On Error Resume Next
> > If Worksheets(c.Value) Is Nothing Then
> > *Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = c
> > End If
> > *.ShowAllData
> > *.Range("a1:a" & lr).AutoFilter field:=1, Criteria1:=c
> > dlr = Sheets(c.Value).Cells(Rows.Count, "a").End(xlUp).Row + 1
> > *.Range("a2:a" & lr).Copy Sheets(c.Value).Range("a" & dlr)
> > Next c
> > *.ShowAllData
> > *.Range("a1:a" & lr).AutoFilter
> > End With
> > Application.ScreenUpdating = True
> > Sheets("Data").Select

>
> > End Sub- Hide quoted text -

>
> - Show quoted text -


 
Reply With Quote
 
Ron de Bruin
Guest
Posts: n/a
 
      21st Mar 2008
Yes, I will post a example after dinner

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Steve" <(E-Mail Removed)> wrote in message news:a38ecdcf-6050-4774-b138-(E-Mail Removed)...
Thanks Ron! Is there a way to only create sheets and copy data for
specific values in column A? The number of unique values that I have
is about 300...I dont want to create 300 sheets! I'm really only
interested in copying out about 20 of the customers. I have the
customer numbers listed in a sheet called "control", range a1:a20. It
is also a named range called "customer". Thanks again for your help!!


On Mar 21, 10:12 am, "Ron de Bruin" <rondebr...@kabelfoon.nl> wrote:
> Try this one Stevehttp://www.rondebruin.nl/copy5.htm#sheet
>
> --
>
> Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm
>
>
>
> "Steve" <steve_andrus...@yahoo.com> wrote in messagenews:14d136fc-dbba-44bc-bd4b-(E-Mail Removed)...
> > Hello everyone. I have a data sheet that 14,000 rows long. In column
> > A is the customer number. Then I have a "control" sheet, where I have
> > a list of customer numbers to pull (copy) from the data sheet
> > (A3:A20). Can VBA scan the data sheet, create a new sheet for all
> > entries in Control("A3:A20"), and copy in the entire row for every
> > instance found in the data sheet for each customer identified in
> > Control("A3:A20")?

>
> > I have some code below that looks at the data sheet, and based on the
> > value in column A creates a sheet for each unique instance and copies
> > the data in. Can this be modified to incorporate the list of values
> > in the Control sheet? Basically, The data sheet has over 300
> > customers in column A. I dont want to create 300 sheets! Only about
> > 20, that will be in the list in Control("A1:A20"). Thanks!!

>
> > Sub ParseData()

>
> > Application.ScreenUpdating = False
> > With Sheets("Data")
> > lr = .Cells(Rows.Count, "a").End(xlUp).Row
> > .Range("A1:A" & lr).AdvancedFilter Action:=xlFilterInPlace,
> > Unique:=True
> > For Each c In .Range("a2:a" & lr).SpecialCells(xlVisible)
> > On Error Resume Next
> > If Worksheets(c.Value) Is Nothing Then
> > Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = c
> > End If
> > .ShowAllData
> > .Range("a1:a" & lr).AutoFilter field:=1, Criteria1:=c
> > dlr = Sheets(c.Value).Cells(Rows.Count, "a").End(xlUp).Row + 1
> > .Range("a2:a" & lr).Copy Sheets(c.Value).Range("a" & dlr)
> > Next c
> > .ShowAllData
> > .Range("a1:a" & lr).AutoFilter
> > End With
> > Application.ScreenUpdating = True
> > Sheets("Data").Select

>
> > End Sub- Hide quoted text -

>
> - Show quoted text -


 
Reply With Quote
 
Steve
Guest
Posts: n/a
 
      21st Mar 2008
Thanks Ron!!

On Mar 21, 10:41*am, "Ron de Bruin" <rondebr...@kabelfoon.nl> wrote:
> Yes, I will post a example after dinner
>
> --
>
> Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm
>
> "Steve" <steve_andrus...@yahoo.com> wrote in messagenews:a38ecdcf-6050-4774-b138-(E-Mail Removed)...
>
> Thanks Ron! *Is there a way to only create sheets and copy data for
> specific values in column A? *The number of unique values that I have
> is about 300...I dont want to create 300 sheets! *I'm really only
> interested in copying out about 20 of the customers. *I have the
> customer numbers listed in a sheet called "control", range a1:a20. *It
> is also a named range called "customer". *Thanks again for your help!!
>
> On Mar 21, 10:12 am, "Ron de Bruin" <rondebr...@kabelfoon.nl> wrote:
>
>
>
> > Try this one Stevehttp://www.rondebruin.nl/copy5.htm#sheet

>
> > --

>
> > Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm

>
> > "Steve" <steve_andrus...@yahoo.com> wrote in messagenews:14d136fc-dbba-44bc-bd4b-(E-Mail Removed)...
> > > Hello everyone. I have a data sheet that 14,000 rows long. In column
> > > A is the customer number. Then I have a "control" sheet, where I have
> > > a list of customer numbers to pull (copy) from the data sheet
> > > (A3:A20). Can VBA scan the data sheet, create a new sheet for all
> > > entries in Control("A3:A20"), and copy in the entire row for every
> > > instance found in the data sheet for each customer identified in
> > > Control("A3:A20")?

>
> > > I have some code below that looks at the data sheet, and based on the
> > > value in column A creates a sheet for each unique instance and copies
> > > the data in. Can this be modified to incorporate the list of values
> > > in the Control sheet? Basically, The data sheet has over 300
> > > customers in column A. I dont want to create 300 sheets! Only about
> > > 20, that will be in the list in Control("A1:A20"). Thanks!!

>
> > > Sub ParseData()

>
> > > Application.ScreenUpdating = False
> > > With Sheets("Data")
> > > lr = .Cells(Rows.Count, "a").End(xlUp).Row
> > > .Range("A1:A" & lr).AdvancedFilter Action:=xlFilterInPlace,
> > > Unique:=True
> > > For Each c In .Range("a2:a" & lr).SpecialCells(xlVisible)
> > > On Error Resume Next
> > > If Worksheets(c.Value) Is Nothing Then
> > > Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = c
> > > End If
> > > .ShowAllData
> > > .Range("a1:a" & lr).AutoFilter field:=1, Criteria1:=c
> > > dlr = Sheets(c.Value).Cells(Rows.Count, "a").End(xlUp).Row + 1
> > > .Range("a2:a" & lr).Copy Sheets(c.Value).Range("a" & dlr)
> > > Next c
> > > .ShowAllData
> > > .Range("a1:a" & lr).AutoFilter
> > > End With
> > > Application.ScreenUpdating = True
> > > Sheets("Data").Select

>
> > > End Sub- Hide quoted text -

>
> > - Show quoted text -- Hide quoted text -

>
> - Show quoted text -


 
Reply With Quote
 
Ron de Bruin
Guest
Posts: n/a
 
      21st Mar 2008
Try this Steve

Sub Copy_To_Worksheets_Test()
Dim CalcMode As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim cell As Range
Dim Lrow As Long
Dim FieldNum As Integer

'Name of the sheet with your data
Set ws1 = Sheets("Sheet1") '<<< Change

'Set filter range : A1 is the top left cell of your filter range and
'the header of the first column, D is the last column in the filter range
Set rng = ws1.Range("A1" & Rows.Count)

'Set Field number of the filter column
'This example filters on the first field in the range(change the field if needed)
'In this case the range starts in A so Field:=1 is column A, 2 = column B, ......
FieldNum = 1

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

' Worksheet with the list of customers numbers in column A
Set ws2 = Worksheets("control")

With ws2

'loop through the list in ws2 and filter/copy to a new sheet
Lrow = .Cells(Rows.Count, "A").End(xlUp).Row
For Each cell In .Range("A1:A" & Lrow)

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

'Firstly, remove the AutoFilter
ws1.AutoFilterMode = False

'Filter the range
rng.AutoFilter Field:=FieldNum, Criteria1:="=" & cell.Value

'Copy the visible data and use PasteSpecial to paste to the new worksheet
ws1.AutoFilter.Range.Copy
With WSNew.Range("A1")
' Paste:=8 will copy the columnwidth in Excel 2000 and higher
.PasteSpecial Paste:=8
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
.Select
End With

'Close AutoFilter
ws1.AutoFilterMode = False

Next cell

'Delete the ws2 sheet
On Error Resume Next
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
On Error GoTo 0

End With

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



--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Steve" <(E-Mail Removed)> wrote in message news:2a98fab8-495a-48af-9bd7-(E-Mail Removed)...
Thanks Ron!!

On Mar 21, 10:41 am, "Ron de Bruin" <rondebr...@kabelfoon.nl> wrote:
> Yes, I will post a example after dinner
>
> --
>
> Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm
>
> "Steve" <steve_andrus...@yahoo.com> wrote in messagenews:a38ecdcf-6050-4774-b138-(E-Mail Removed)...
>
> Thanks Ron! Is there a way to only create sheets and copy data for
> specific values in column A? The number of unique values that I have
> is about 300...I dont want to create 300 sheets! I'm really only
> interested in copying out about 20 of the customers. I have the
> customer numbers listed in a sheet called "control", range a1:a20. It
> is also a named range called "customer". Thanks again for your help!!
>
> On Mar 21, 10:12 am, "Ron de Bruin" <rondebr...@kabelfoon.nl> wrote:
>
>
>
> > Try this one Stevehttp://www.rondebruin.nl/copy5.htm#sheet

>
> > --

>
> > Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm

>
> > "Steve" <steve_andrus...@yahoo.com> wrote in messagenews:14d136fc-dbba-44bc-bd4b-(E-Mail Removed)...
> > > Hello everyone. I have a data sheet that 14,000 rows long. In column
> > > A is the customer number. Then I have a "control" sheet, where I have
> > > a list of customer numbers to pull (copy) from the data sheet
> > > (A3:A20). Can VBA scan the data sheet, create a new sheet for all
> > > entries in Control("A3:A20"), and copy in the entire row for every
> > > instance found in the data sheet for each customer identified in
> > > Control("A3:A20")?

>
> > > I have some code below that looks at the data sheet, and based on the
> > > value in column A creates a sheet for each unique instance and copies
> > > the data in. Can this be modified to incorporate the list of values
> > > in the Control sheet? Basically, The data sheet has over 300
> > > customers in column A. I dont want to create 300 sheets! Only about
> > > 20, that will be in the list in Control("A1:A20"). Thanks!!

>
> > > Sub ParseData()

>
> > > Application.ScreenUpdating = False
> > > With Sheets("Data")
> > > lr = .Cells(Rows.Count, "a").End(xlUp).Row
> > > .Range("A1:A" & lr).AdvancedFilter Action:=xlFilterInPlace,
> > > Unique:=True
> > > For Each c In .Range("a2:a" & lr).SpecialCells(xlVisible)
> > > On Error Resume Next
> > > If Worksheets(c.Value) Is Nothing Then
> > > Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = c
> > > End If
> > > .ShowAllData
> > > .Range("a1:a" & lr).AutoFilter field:=1, Criteria1:=c
> > > dlr = Sheets(c.Value).Cells(Rows.Count, "a").End(xlUp).Row + 1
> > > .Range("a2:a" & lr).Copy Sheets(c.Value).Range("a" & dlr)
> > > Next c
> > > .ShowAllData
> > > .Range("a1:a" & lr).AutoFilter
> > > End With
> > > Application.ScreenUpdating = True
> > > Sheets("Data").Select

>
> > > End Sub- Hide quoted text -

>
> > - Show quoted text -- Hide quoted text -

>
> - Show quoted text -


 
Reply With Quote
 
Steve
Guest
Posts: n/a
 
      24th Mar 2008
Thanks guys!!

On Mar 21, 11:57*am, "Ron de Bruin" <rondebr...@kabelfoon.nl> wrote:
> Try thisSteve
>
> Sub Copy_To_Worksheets_Test()
> * * Dim CalcMode As Long
> * * Dim ws1 As Worksheet
> * * Dim ws2 As Worksheet
> * * Dim WSNew As Worksheet
> * * Dim rng As Range
> * * Dim cell As Range
> * * Dim Lrow As Long
> * * Dim FieldNum As Integer
>
> * * 'Name of the sheet with your data
> * * Set ws1 = Sheets("Sheet1") *'<<< Change
>
> * * 'Set filter range : A1 is the top left cell of your filter range and
> * * 'the header of the first column, D is the last column in the filter range
> * * Set rng = ws1.Range("A1" & Rows.Count)
>
> * * 'Set Field number of the filter column
> * * 'This example filters on the first field in the range(change the field if needed)
> * * 'In this case the range starts in A so Field:=1 is column A, 2 = column B, ......
> * * FieldNum = 1
>
> * * With Application
> * * * * CalcMode = .Calculation
> * * * * .Calculation = xlCalculationManual
> * * * * .ScreenUpdating = False
> * * End With
>
> * * ' Worksheet with the list of customers numbers in column A
> * * Set ws2 = Worksheets("control")
>
> * * With ws2
>
> * * * * 'loop through the *list in ws2 and filter/copy to a new sheet
> * * * * Lrow = .Cells(Rows.Count, "A").End(xlUp).Row
> * * * * For Each cell In .Range("A1:A" & Lrow)
>
> * * * * * * 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
>
> * * * * * * 'Firstly, remove the AutoFilter
> * * * * * * ws1.AutoFilterMode = False
>
> * * * * * * 'Filter the range
> * * * * * * rng.AutoFilter Field:=FieldNum, Criteria1:="=" & cell.Value
>
> * * * * * * 'Copy the visible data and use PasteSpecial to paste to the new worksheet
> * * * * * * ws1.AutoFilter.Range.Copy
> * * * * * * With WSNew.Range("A1")
> * * * * * * * * ' Paste:=8 will copy the columnwidth in Excel 2000 and higher
> * * * * * * * * .PasteSpecial Paste:=8
> * * * * * * * * .PasteSpecial xlPasteValues
> * * * * * * * * .PasteSpecial xlPasteFormats
> * * * * * * * * Application.CutCopyMode = False
> * * * * * * * * .Select
> * * * * * * End With
>
> * * * * * * 'Close AutoFilter
> * * * * * * ws1.AutoFilterMode = False
>
> * * * * Next cell
>
> * * * * 'Delete the ws2 sheet
> * * * * On Error Resume Next
> * * * * Application.DisplayAlerts = False
> * * * * .Delete
> * * * * Application.DisplayAlerts = True
> * * * * On Error GoTo 0
>
> * * End With
>
> * * With Application
> * * * * .ScreenUpdating = True
> * * * * .Calculation = CalcMode
> * * End With
> End Sub
>
> --
>
> Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm
>
> "Steve" <steve_andrus...@yahoo.com> wrote in messagenews:2a98fab8-495a-48af-9bd7-(E-Mail Removed)...
>
> Thanks Ron!!
>
> On Mar 21, 10:41 am, "Ron de Bruin" <rondebr...@kabelfoon.nl> wrote:
>
>
>
> > Yes, I will post a example after dinner

>
> > --

>
> > Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm

>
> > "Steve" <steve_andrus...@yahoo.com> wrote in messagenews:a38ecdcf-6050-4774-b138-(E-Mail Removed)...

>
> > Thanks Ron! Is there a way to only create sheets and copy data for
> > specific values in column A? The number of unique values that I have
> > is about 300...I dont want to create 300 sheets! I'm really only
> > interested in copying out about 20 of the customers. I have the
> > customer numbers listed in a sheet called "control", range a1:a20. It
> > is also a named range called "customer". Thanks again for your help!!

>
> > On Mar 21, 10:12 am, "Ron de Bruin" <rondebr...@kabelfoon.nl> wrote:

>
> > > Try this oneStevehttp://www.rondebruin.nl/copy5.htm#sheet

>
> > > --

>
> > > Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm

>
> > > "Steve" <steve_andrus...@yahoo.com> wrote in messagenews:14d136fc-dbba-44bc-bd4b-(E-Mail Removed)...
> > > > Hello everyone. I have a data sheet that 14,000 rows long. In column
> > > > A is the customer number. Then I have a "control" sheet, where I have
> > > > a list of customer numbers to pull (copy) from the data sheet
> > > > (A3:A20). Can VBA scan the data sheet, create a new sheet for all
> > > > entries in Control("A3:A20"), and copy in the entire row for every
> > > > instance found in the data sheet for each customer identified in
> > > > Control("A3:A20")?

>
> > > > I have some code below that looks at the data sheet, and based on the
> > > > value in column A creates a sheet for each unique instance and copies
> > > > the data in. Can this be modified to incorporate the list of values
> > > > in the Control sheet? Basically, The data sheet has over 300
> > > > customers in column A. I dont want to create 300 sheets! Only about
> > > > 20, that will be in the list in Control("A1:A20"). Thanks!!

>
> > > > Sub ParseData()

>
> > > > Application.ScreenUpdating = False
> > > > With Sheets("Data")
> > > > lr = .Cells(Rows.Count, "a").End(xlUp).Row
> > > > .Range("A1:A" & lr).AdvancedFilter Action:=xlFilterInPlace,
> > > > Unique:=True
> > > > For Each c In .Range("a2:a" & lr).SpecialCells(xlVisible)
> > > > On Error Resume Next
> > > > If Worksheets(c.Value) Is Nothing Then
> > > > Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = c
> > > > End If
> > > > .ShowAllData
> > > > .Range("a1:a" & lr).AutoFilter field:=1, Criteria1:=c
> > > > dlr = Sheets(c.Value).Cells(Rows.Count, "a").End(xlUp).Row + 1
> > > > .Range("a2:a" & lr).Copy Sheets(c.Value).Range("a" & dlr)
> > > > Next c
> > > > .ShowAllData
> > > > .Range("a1:a" & lr).AutoFilter
> > > > End With
> > > > Application.ScreenUpdating = True
> > > > Sheets("Data").Select

>
> > > > End Sub- Hide quoted text -

>
> > > - Show quoted text -- Hide quoted text -

>
> > - Show quoted text -- Hide quoted text -

>
> - Show quoted text -


 
Reply With Quote
 
 
 
Reply

Thread Tools
Rate This Thread
Rate This Thread:

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
copy rows from one Data sheet to another sheet based on cell conte John McKeon Microsoft Excel Misc 2 15th May 2010 06:49 AM
Copy data from sheet 1 to sheet 2 based on day/date jonpdavies@gmail.com Microsoft Excel Programming 7 1st Oct 2005 04:59 PM
MACRO - copy rows based on value in column to another sheet =?Utf-8?B?TWljaGFlbCBB?= Microsoft Excel Misc 1 5th Mar 2005 02:15 AM
copy to another sheet based on column value =?Utf-8?B?TWlrZQ==?= Microsoft Excel Programming 4 5th Mar 2005 12:50 AM
MACRO - copy rows based on value in column to another sheet =?Utf-8?B?TWlrZQ==?= Microsoft Excel Programming 2 5th Mar 2005 12:21 AM


Features
 

Advertising
 

Newsgroups
 


All times are GMT +1. The time now is 08:07 AM.