Replace Array using a table to be maintained by a user

[PhosFeedLogisticsMan]

I currently have a sub in my workbook, that sorts some data, then creates tabs based on a range and the Array argument. The problem I see is when I leave or for someone without experience in VBA would need to add or delete some of the Array arguments. I want to get rid of the code, and maintain this list in a worksheet within the workbook(calling it SCAC_Codes). Then any user can maintain that worksheet adding and deleting the data in Column A. Here is what I currently have with some formatting towards the end. Can anyone help? I'm not a guru with this VBA stuff, but am learning. Here is my code:

Sub NewOrders_FilterToSheets()
'
'
'
Application.ScreenUpdating = False
Sheets("NewOrders").Activate
ActiveWorkbook.Worksheets("NewOrders").AutoFilter.Sort.SortFields.Clear
On Error Resume Next
ActiveSheet.ShowAllData



Dim SourceSheet As Worksheet
Dim TargetSheet As Worksheet
Dim SheetNames As Variant
Dim i As Long
Dim LR As Long
'EDIT
Set SourceSheet = Sheets("NewOrders")
SheetNames = Array("BLHW", "CCTI", "CCTI", "RLRN", "CMMO", "WLPO", "SWGQ", "RJSV", "OKLB", "ADMH", "BNTI", "BTXR", "DDGR", "DONM", "ECBI", "KCAR", "MEYT", "NOWN", "PAIS", "TATQ", "TUTU", "TYDS", "VHTI", "MYER", "SKYV", "LKNW", "HINT", "VANT")
Const FilterColumn = 1
'END EDIT
With SourceSheet
LR = .Range("A" & .Rows.Count).End(xlUp).Row

For i = 0 To UBound(SheetNames)
Set TargetSheet = Worksheets(SheetNames(i))
TargetSheet.Cells.ClearContents



With .Range("A2:Q" & LR)
.AutoFilter Field:=FilterColumn, Criteria1:=SheetNames(i)
.Offset(0, 0).Copy TargetSheet.Range("A1")
End With
Next i
End With


Sheets(Array("BLHW", "CCTI", "CCTI", "RLRN", "CMMO", "WLPO", "SWGQ", "RJSV", "OKLB", "ADMH", "BNTI", "BTXR", "DDGR", "DONM", "ECBI", "KCAR", "MEYT", "NOWN", "PAIS", "TATQ", "TUTU", "TYDS", "VHTI", "MYER", "SKYV", "LKNW", "HINT", "VANT")).Select

Range("A:Q").Columns.AutoFit
Cells.Select
Cells.EntireColumn.AutoFit
Columns("O:Q").Select
Selection.ColumnWidth = 35.01
Columns("B").Select
Selection.ColumnWidth = 10.01
Columns("C").Select
Selection.ColumnWidth = 25.01
Columns("D").Select
Selection.ColumnWidth = 6.01
Columns("E").Select
Selection.ColumnWidth = 25.01
Columns("F:G").Select
Selection.ColumnWidth = 25.01
Columns("H").Select
Selection.ColumnWidth = 6.01
Columns("I").Select
Selection.ColumnWidth = 25.01
Columns("J").Select
Selection.ColumnWidth = 25.01
Columns("K").Select
Selection.ColumnWidth = 5.01
Columns("L").Select
Selection.ColumnWidth = 5.01
Columns("M").Select
Selection.ColumnWidth = 5.01
Columns("N").Select
Selection.ColumnWidth = 25.01
Columns("O").Select
Selection.ColumnWidth = 25.01
'Columns("P").Select
'Selection.ColumnWidth = 35.01
'Columns("Q").Select
'Selection.ColumnWidth = 25.01
Cells.Select
Cells.EntireRow.AutoFit

Sheets("MENU").Activate

'Calling other subs

RemoveEmptySheets
ChangeSubjectNewLoads
ChangeBodyNewLoads
HideNewOrders
CCtoOORorNot


Application.ScreenUpdating = True


End Sub

 

[Fluff]

How about something like this

Sub sheetsarray()

    Dim ShtLst() As Variant
    
    With Sheets("View")
        ShtLst = .Range("A8", .Range("A8").End(xlDown)).Value
    End With
    Sheets(Application.Transpose(ShtLst)).Select
    
End Sub

Changing sheet name & range as required

 

[PhosFeedLogisticsMan]

Fluff- Not sure I am explaining correctly, or if the code above works. I may be able to simplify my question. I think all I need to do is change SheetNames in my code to point to a spreadsheet in my workbook called SCAC_Codes then look down all of Column A(that would replace the Array in my sub).

 

[Fluff]

That's what my code does it looks at a sheet called View range A8 downwards & sets those values to an array. It then selects all the sheets in that array there by replacing this part of your code

Sheets(Array("BLHW", "CCTI", "CCTI", "RLRN", "CMMO", "WLPO", "SWGQ",  "RJSV", "OKLB", "ADMH", "BNTI", "BTXR", "DDGR", "DONM", "ECBI", "KCAR",  "MEYT", "NOWN", "PAIS", "TATQ", "TUTU", "TYDS", "VHTI", "MYER", "SKYV",  "LKNW", "HINT", "VANT")).Select

 

[PhosFeedLogisticsMan]

Okay... the part you have worked out just fine. The other portion of my code:

Dim SourceSheet As Worksheet
Dim TargetSheet As Worksheet
Dim SheetNames As Variant
Dim i As Long
Dim LR As Long
'EDIT
Set SourceSheet = Sheets("NewOrders")
SheetNames = Array("BLHW", "CCTI", "CCTI", "RLRN", "CMMO", "WLPO", "SWGQ", "RJSV", "OKLB", "ADMH", "BNTI", "BTXR", "DDGR", "DONM", "ECBI", "KCAR", "MEYT", "NOWN", "PAIS", "TATQ", "TUTU", "TYDS", "VHTI", "MYER", "SKYV", "LKNW", "HINT", "VANT")
Const FilterColumn = 1
'END EDIT
With SourceSheet
LR = .Range("A" & .Rows.Count).End(xlUp).Row

For i = 0 To UBound(SheetNames)
Set TargetSheet = Worksheets(SheetNames(i))
TargetSheet.Cells.ClearContents



With .Range("A2:Q" & LR)
.AutoFilter Field:=FilterColumn, Criteria1:=SheetNames(i)
.Offset(0, 0).Copy TargetSheet.Range("A1")
End With
Next i
End With


Is also what I need to figure out, so a user can just maintain that SCAC_Code sheet and not the VBA code. Thank you for the other part ...that did work. Can you help me with this piece of code as well?

 

[Fluff]

Untested but try

Sub sheetsarray()

    Dim ShtLst() As Variant
    
    Dim SourceSheet As Worksheet
    Dim TargetSheet As Worksheet
    Dim SheetNames As Variant
    Dim i As Long
    Dim LR As Long
    
    With Sheets("SCAC_Code")
        SheetNames = .Range("A2", .Range("A2").End(xlDown)).Value
    End With

    'EDIT
    Set SourceSheet = Sheets("NewOrders")
    Const FilterColumn = 1
    'END EDIT
    With SourceSheet
        LR = .Range("A" & .Rows.Count).End(xlUp).Row
    
        For i = 0 To UBound(SheetNames)
            Set TargetSheet = Worksheets(SheetNames(i))
            TargetSheet.Cells.ClearContents
            
            With .Range("A2:Q" & LR)
                .AutoFilter Field:=FilterColumn, Criteria1:=SheetNames(i)
                .Offset(0, 0).Copy TargetSheet.Range("A1")
            End With
        Next i
    End With
End Sub

 

[PhosFeedLogisticsMan]

I'm getting subscript out of range on this line

Set TargetSheet = Worksheets(SheetNames(i))

 

[Fluff]

Ok, try this

Sub sheetsarray()

    Dim ShtLst() As Variant
    
    Dim SourceSheet As Worksheet
    Dim TargetSheet As Worksheet
    Dim SheetNames() As Variant
    Dim i As Long
    Dim LR As Long
    
    With Sheets("SCAC_Code")
        SheetNames = .Range("A1", .Range("A1").End(xlDown)).Value
    End With

    'EDIT
    Set SourceSheet = Sheets("NewOrders")
    Const FilterColumn = 1
    'END EDIT
    With SourceSheet
        LR = .Range("A" & .Rows.Count).End(xlUp).Row
    
        For i = LBound(SheetNames) To UBound(SheetNames)
            Set TargetSheet = Worksheets(Application.Transpose(SheetNames)(i))
            TargetSheet.Cells.ClearContents
            
            With .Range("A2:Q" & LR)
                .AutoFilter Field:=FilterColumn, Criteria1:=Application.Transpose(SheetNames)(i)
                .Offset(0, 0).Copy TargetSheet.Range("A1")
            End With
        Next i
    End With
End Sub

 

[PhosFeedLogisticsMan]

Fluff!!!! You're amazing... that did it. Thank you so much for all the help. When I leave this job, I can rest in peace that someone with less knowledge than even myself can maintain that table! Again... thank you!

 

[Fluff]

Glad to help & thanks for the feedback