Help Looping VBA

Hi

I'm trying to get my code to copy & paste some data onto a new workbook, remove and resize some columns, save and close the workbook and then select the next name from a dropdown menu and repeat the process until the end of the list is reached. Whilst I've achieved most of it I'm stuck at the looping the whole module.

Below is my code, any help would be greatly appreciated;-

Sub IndvReport()
'
' IndvReport Macro
'

'
Workbooks.Add
Application.DisplayAlerts = False
Application.WindowState = xlMaximized
ChDir _
"U:\Housing\CSC and CEX Admin Centre\CSC\CSC Reports\Agents Stats\Weekly\Individual Reports"
ActiveWorkbook.SaveAs filename:= _
"U:\Housing\CSC and CEX Admin Centre\CSC\CSC Reports\Agents Stats\Weekly\Individual Reports\Book1.xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Windows("Test Weekly Agent Stats.xlsm").Activate
Cells.Select
Selection.Copy
Windows("Book1.xlsx").Activate
ActiveSheet.Paste
Application.WindowState = xlMaximized
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("B:D").Select
ActiveSheet.Shapes.Range(Array("Straight Arrow Connector 1")).Select
Selection.Delete
Range("C1:F2").Select
Range("F1").Activate
Application.CutCopyMode = False
Selection.ClearContents
Range("A1:A2").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Columns("B:D").Select
Selection.Delete Shift:=xlToLeft
Columns("C:F").Select
Selection.Delete Shift:=xlToLeft
Columns("J:K").Select
Selection.Delete Shift:=xlToLeft
Columns("L:L").Select
Selection.Delete Shift:=xlToLeft
Range("N:Q,T:W,AB:AH").Select
Range("AB1").Activate
Selection.Delete Shift:=xlToLeft
Columns("Z:AC").Select
Selection.Delete Shift:=xlToLeft
Columns("S:S").EntireColumn.AutoFit
Columns("T:T").EntireColumn.AutoFit
Columns("X:Y").Select
Selection.Delete Shift:=xlToLeft
Range("B3").Select
Selection.Copy
Range("B3:D3").Select
ActiveSheet.Paste
Range("G28").Select
Application.CutCopyMode = False
Range("A1:A2").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Dim Path As String
Dim filename As String
Path = "U:\Housing\CSC and CEX Admin Centre\CSC\CSC Reports\Agents Stats\Weekly\Individual Reports"
filename = Range("A1")
ActiveWorkbook.SaveAs filename:=Path & filename & ".xls", FileFormat:=xlNormal
ActiveWindow.Close

Dim dv As Validation
Dim vaSplit As Variant
Dim i As Long

Set dv = ActiveCell.Validation

vaSplit = Range(dv.Formula1).Value

For i = LBound(vaSplit, 1) To UBound(vaSplit, 1)
If vaSplit(i, 1) = ActiveCell.Value Then
If i < UBound(vaSplit, 1) Then
ActiveCell.Value = vaSplit(i + 1, 1)
Exit For
End If
End If
Next i
Application.DisplayAlerts = True


End Sub

Hi

Thanks for your reply, I have uploaded a copy of the file, I'm still working exactly I want to do on the new saved workbook with columns etc, the main issue I'm having the code repeat until the last name in the dropdown list has been reached

Thank you

I have reattached it and removed the password

Yes if possible I'd like it to create an individual one for each agent in the list

That's fantastic, thank you. The only issue seems to be when it reaches the final agent in the list it errors, shows error code "Run Time Error '9': Subscript out of range and it highlights this section of the code - Range("A1:A2") = vaSplit(i + 1, 1) so the code doesn't finish running.
Also would there be a way to hide the lookup sheet on the newly created workbooks as part of the process?

Thank you again. That hides the Lookup sheet on the new workbooks which is great however the same Runtime error pops up when reaching the last agent

that works perfectly now, thank you

After checking the workbooks the VBA is creating and saving it seems that all of them are identical apart from the Agent Name, its duplicating the stats for Agent 1 and saving them for all of the other agents so doesn't seem to be functioning correctly.

I have added a bit to remove and format columns so they current VBA is now;-

Sub IndvReport()
Application.ScreenUpdating = False
Dim dv As Validation, vaSplit As Variant, i As Long, Path As String, filename As String
Sheets(Array("Individual Stats", "Lookup")).Copy
ActiveSheet.UsedRange.Cells.Value = ActiveSheet.UsedRange.Cells.Value
Range("B:D,F:K,P:R,U:U,X:Y,AD:AG,AJ:BD").Delete

Range("I3:P3,A1:A2,I5:P22,I4:P4,I23:P23").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone


End With
Path = "U:\Housing\CSC and CEX Admin Centre\CSC\CSC Reports\Agents Stats\Weekly\Individual Reports"
Set dv = Range("A1:A2").Validation
vaSplit = Range(dv.Formula1).Value
For i = LBound(vaSplit, 1) To UBound(vaSplit, 1)
filename = vaSplit(i, 1)
Range("A1") = vaSplit(i, 1)
With ActiveWorkbook
Application.DisplayAlerts = False
.SaveAs filename:=Path & filename & ".xlsx", FileFormat:=51
Application.DisplayAlerts = True
End With
If i + 1 <= UBound(vaSplit, 1) Then
Range("A1:A2") = vaSplit(i + 1, 1)
End If
Sheets("Lookup").Visible = xlVeryHidden
Next i
Application.ScreenUpdating = True
End Sub

Apologies, I confused the issue by not including enough data in my uploaded file. I have uploaded another sample file. The summary Tab looks up the agent performance for the previous weeks which changes as you select a different agent in the dropdown box in A1. The aim is to export and save the data for agent 1, change the name to the next name is the list, export and save and continue until the last name in the list

That works perfectly, thank you