stewartlloyd
10-06-2007, 11:24 PM
Hi all,
THis is my first post so please bare with me.
I have a list of about 4000 rows longs with about 250 unique records within the list.
This list is a list of customers and I need to run the following which takes each customer and copies it to a seperate sheet for formatting and distirbution.
Rather than me manually running this macro having to filter on each client I want to know if the macro can run as is below but select automatically each different customer, select the appropriate range...
Hope someone can help, im very much a vb/excel novice so any help would be great;y appreciated.
Sub statementgenerator()
'
' statementgenerator Macro
'
'
Range("C14").Select
ChDir "C:\Documents and Settings\Owner\Desktop"
Workbooks.Open Filename:= _
"C:\Documents and Settings\Owner\Desktop\Stewsstandardtemplate.xls"
ActiveWindow.LargeScroll ToRight:=-1
Range("A7").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("A7").Select
Windows("Custlistcurrent.xls").Activate
ActiveWindow.SmallScroll Down:=-27
ActiveWorkbook.Worksheets("custlistcurrent").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("custlistcurrent").AutoFilter.Sort.SortFields.Add _
Key:=Range("C1:C4289"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("custlistcurrent").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A2:L2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("Stewsstandardtemplate.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Sheet3").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").AutoFilter.Sort.SortFields.Add Key:=Range _
("L6:L201"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("D7").Select
Selection.End(xlDown).Select
Range("D4295").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("D4293").Select
Selection.End(xlUp).Select
Range("A7").Select
ActiveWindow.SmallScroll Down:=-15
'Saves filename as value of C7 plus the current date
Dim newFile As String, fName As String
' Don't use "/" in date, invalid syntax
fName = Range("C7").Value
'Change the date format to whatever you'd like, but make sure it's in quotes
newFile = fName & " " & Format$(Date, "mm-dd-yyyy")
' Change directory to suit your PC, including USER NAME
ChDir _
"C:\statements"
ActiveWorkbook.SaveAs Filename:=newFile
End Sub
THis is my first post so please bare with me.
I have a list of about 4000 rows longs with about 250 unique records within the list.
This list is a list of customers and I need to run the following which takes each customer and copies it to a seperate sheet for formatting and distirbution.
Rather than me manually running this macro having to filter on each client I want to know if the macro can run as is below but select automatically each different customer, select the appropriate range...
Hope someone can help, im very much a vb/excel novice so any help would be great;y appreciated.
Sub statementgenerator()
'
' statementgenerator Macro
'
'
Range("C14").Select
ChDir "C:\Documents and Settings\Owner\Desktop"
Workbooks.Open Filename:= _
"C:\Documents and Settings\Owner\Desktop\Stewsstandardtemplate.xls"
ActiveWindow.LargeScroll ToRight:=-1
Range("A7").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("A7").Select
Windows("Custlistcurrent.xls").Activate
ActiveWindow.SmallScroll Down:=-27
ActiveWorkbook.Worksheets("custlistcurrent").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("custlistcurrent").AutoFilter.Sort.SortFields.Add _
Key:=Range("C1:C4289"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("custlistcurrent").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A2:L2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("Stewsstandardtemplate.xls").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Sheet3").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet3").AutoFilter.Sort.SortFields.Add Key:=Range _
("L6:L201"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Sheet3").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("D7").Select
Selection.End(xlDown).Select
Range("D4295").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("D4293").Select
Selection.End(xlUp).Select
Range("A7").Select
ActiveWindow.SmallScroll Down:=-15
'Saves filename as value of C7 plus the current date
Dim newFile As String, fName As String
' Don't use "/" in date, invalid syntax
fName = Range("C7").Value
'Change the date format to whatever you'd like, but make sure it's in quotes
newFile = fName & " " & Format$(Date, "mm-dd-yyyy")
' Change directory to suit your PC, including USER NAME
ChDir _
"C:\statements"
ActiveWorkbook.SaveAs Filename:=newFile
End Sub