I am having an issue where the below code will run fine in debug mode, but is throwing a 400 Error when activated normally. It keeps getting stuck on the Sub Assignee_List
part of the code specifically the Sheets("Input List").Range("A1").CurrentRegion.SpecialCells(xlCellTypeConstants).Select
line. I have no idea why.
Sorry for posting the large block of code, but I have no idea what parts are causing the issue. As far as I can tell from my locals window during debug, the code isn't pulling any values from other subs, into the Assignee_List sub.
For context the Assignee_List
sub looks at the name of a staff member assigned to a list of tasks and filters it to a list of unique values (each name appears once) then turns the list into a named range to support a data validation list elsewhere in the workbook
Sub Dashboard_Update()
'Main Sub which runs all other subs from the 'Update' dashboard button
Proceed1 = MsgBox("Have you Captured a Burndown Snapshot? (If Required)", vbYesNo + vbQuestion, "Dashboard Update")
If Proceed1 = vbYes Then
Proceed2 = MsgBox("Have you Deleted Data from Input Sheet?", vbYesNo + vbQuestion, "Dashboard Update")
If Proceed1 = vbYes Then
Clear_Sheets
Delete_NonActions
Assignee_List
FilterAndCopy
Else: Exit Sub
End If
Else: Exit Sub
End If
End Sub
Sub FilterAndCopy()
'filter input table and copy rows to relevant tabs
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Dim lngLastRow As Long
Dim ToDoSheet As Worksheet, InProgressSheet As Worksheet, ClosureSheet As Worksheet, ClosedSheet As Worksheet 'add/remove/update sheet names as needed
Set ToDoSheet = Sheets("To Do") ' Set This to the Sheet name you want all To Do's going to
Set InProgressSheet = Sheets("In Progress") ' Set this to the Sheet name you want all In Progress's going to
Set ClosureSheet = Sheets("Closure Review") ' Set this to the Sheet name you want all Closure Reviews going to
Set ClosedSheet = Sheets("Closed") ' Set this to the Sheet name you want all Closed going to
lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
With Range("A1", "M" & lngLastRow)
.AutoFilter
.AutoFilter Field:=4, Criteria1:="To Do" 'Autofilter field refers to the column number
.Copy ToDoSheet.Range("A1") 'Sheet and cell data will be copied to
.AutoFilter Field:=4, Criteria1:="In Progress"
.Copy InProgressSheet.Range("A1")
.AutoFilter Field:=4, Criteria1:="Closure Review"
.Copy ClosureSheet.Range("A1")
.AutoFilter Field:=4, Criteria1:="Done"
.Copy ClosedSheet.Range("A1")
.AutoFilter
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub Clear_Sheets()
'clears values from specific sheets while preserving formatting
Sheets("To Do").Cells.ClearContents
Sheets("In Progress").Cells.ClearContents
Sheets("Closure Review").Cells.ClearContents
Sheets("Closed").Cells.ClearContents
Sheets("Input List").Cells.ClearContents
End Sub
Sub Delete_NonActions()
'find specific cell values in column A of the Input Sheet and deletes rows
Dim Row As Long
Dim i As Long
Row = Cells(Rows.Count, "A").End(xlUp).Row
For i = Row To 1 Step -1
If Cells(i, 1) = "Transfer Document" Then
Rows(i).Delete
End If
Next
For i = Row To 1 Step -1
If Cells(i, 1) = "Outgoing Data Request" Then
Rows(i).Delete
End If
Next
For i = Row To 1 Step -1
If Cells(i, 1) = "Incoming Data Request" Then
Rows(i).Delete
End If
Next
End Sub
Sub Assignee_List()
'Copies the list of action assignees from the Input Sheet and creates a list of unique entries to create Assignee dropdown list on the dashboard
Sheets("Input Sheet").Range("F1:F65536").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Input List").Range("A1"), Unique:=True
Sheets("Input List").Range("A1").CurrentRegion.SpecialCells(xlCellTypeConstants).Select
Dim tbl As ListObject
Set tbl = ActiveSheet.ListObjects.Add(xlSrcRange, Selection, , xlYes)
'tbl.TableStyle = "TableStyleMedium15"
tbl.DisplayName = "Assignee_List"
End Sub
Sub Burndown_Snapshot()
'Copies the Overall Status Summary Data from the Dashboard and adds to the next empty column of the Historic Status table
'Triggered by the 'Burndown Snapshot' button on the dashboard
Dim sws As Worksheet: Set sws = ThisWorkbook.Worksheets("Dashboard")
Dim srg As Range: Set srg = sws.Range("C3:C7")
Dim dws As Worksheet: Set dws = ThisWorkbook.Worksheets("Historic Status")
Dim lCell As Range
Set lCell = dws.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious)
If lCell Is Nothing Then Exit Sub ' no data in range
Dim dCell As Range: Set dCell = dws.Cells(1, lCell.Column + 1)
Dim drg As Range: Set drg = dCell.Resize(srg.Rows.Count, srg.Columns.Count)
drg.Value = srg.Value
End Sub