Hello, I want to be able to loop through my macro so that it runs for each state I have listed. Can someone please help? I'm not sure where and how to put the code. Here is the code that I currently have. I want to be able to do the first state on my list first, run the whole procedure, then loop back to the top and do it again for the next state and so on. Many thanks.
Sub RunWeeklyReport()
'
' RunWeeklyReport Macro
' Macro recorded
'
'
Dim FPath As String, FName As String, FName2 As String
Dim CellValue As String
Dim NewFilter As String
FPath = "C:\Documents and Settings\Update\Weekly Reports by State\"
FName = "Activity_"
FName2 = "Weekly Update.xls"
CellValue = Workbooks("Weekly Macro.xls").Worksheets("Sheet1").Range("C1").Text
NewFilter = Workbooks("Weekly Macro.xls").Worksheets("Sheet1").Range("B3").Text
Workbooks.Open FPath & FName & NewFilter & ".xls"
Windows("Weekly Macro").Activate
Workbooks.Open FPath & FName2
Sheets("Weekly Lead Update").Copy Before:=Workbooks(FName & NewFilter & ".xls").Sheets(1)
Range("A6:M6").Select
With Selection.Interior
.ColorIndex = 34
.Pattern = xlSolid
End With
Windows(FName2).Activate
ActiveWindow.Close
Windows(FName & NewFilter & ".xls").Activate
Range("A1").Select
ActiveSheet.Next.Select
ActiveWorkbook.Names.Add Name:="StatusData", RefersToR1C1:= _
"=OFFSET(qryByStatus!R1C1,0,0,COUNTA(qryByStatus!C 1),5)"
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatab ase, SourceData:= _
"StatusData").CreatePivotTable TableDestination:="", _
TableName:="PivotTable3", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
ActiveSheet.PivotTables("PivotTable3").AddFields RowFields:=Array("Territory" _
, "Name of Current User"), ColumnFields:="Status", PageFields:="State"
ActiveSheet.PivotTables("PivotTable3").PivotFields ("CountOfInteraction ID"). _
Orientation = xlDataField
ActiveSheet.PivotTables("PivotTable3").PivotFields ("State").CurrentPage = NewFilter
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Data by Status"
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Range("A1").Select
ActiveCell.FormulaR1C1 = "Data by Status - by Territory, User, Status"
Range("A2").Select
ActiveCell.FormulaR1C1 = "Data thru"
Range("B2").Select
ActiveCell.FormulaR1C1 = "='[Weekly Macro.xls]Sheet1'!R1C2"
Range("B2").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
End With
Range("A1:B2").Select
Selection.Font.Bold = True
With Selection.Font
.Name = "MS Sans Serif"
.Size = 12
End With
Range("A4:B4").Select
Selection.Font.Bold = True
With Selection.Interior
.ColorIndex = 34
.Pattern = xlSolid
End With
Range("A6:G6").Select
Selection.Delete Shift:=xlUp
Range(Selection, Selection.End(xlToLeft)).Select
Selection.Font.Bold = True
With Selection.Interior
.ColorIndex = 34
.Pattern = xlSolid
End With
Columns("G:G").EntireColumn.AutoFit
Columns("A:A").ColumnWidth = 16
Range("A1").Select
ActiveSheet.Next.Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
ActiveWorkbook.SaveAs Filename:= _
FPath & FName & NewFilter & " " & CellValue & ".xls" _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Application.DisplayAlerts = True
End Sub