Formatting range for each sheet in array

Question

Function Race()
    Dim MyArray As Variant
    Dim sh As Worksheet
    Dim wo As Workbook, wn As Workbook
    MyArray = Array("GP", "F1")
    Set wo = ActiveWorkbook
    Set wn = Workbooks.Add
    wo.Worksheets(MyArray).Copy before:=wn.Worksheets(1)
    For Each sh In wn.Worksheets
        sh.ListObjects.Item(1).Unlist
        sh.UsedRange.Value = sh.UsedRange.Value
        Sheets(sh).Range("A30:N100000").Select
        Sheets(sh).Range("A30:N100000").Interior.ColorIndex = xlColorIndexNone
        Sheets(sh).Range("A30:N100000").Font.ColorIndex = xlColorIndexAutomatic
        Sheets(sh).Range("A30:N100000").Borders.LineStyle = xlLineStyleNone
        Sheets(sh).Range("A30:N30").Select
        Sheets(sh).Range("A30:N30").Borders.LineStyle = xlContinous
        Sheets(sh).Range("A1").Select
    Next sh
    wn.SaveAs Filename:= _
    ("Q:\Racing\Results\" & Format(Date, "DDMMYY") & " Grand prix & Formula1" & ".xlsx")
    ActiveWindow.Close
End Function

I can't get Sheets(sh).Range("A30:N100000").Select or any other variant of [A30:N100000] selection to work. Anyone able to help?

`sh` is a Workskeet object, and `Sheets(something)` expects a string. Try `sh.Range("A30:N100000").Select` and same with rest of code — Foxfire And Burns And Burns, May 25 '21 at 10:37
Actually you can skip the `.Select` lines there is no need for using `.Select` it just makes your code slow as hell. You might benefit from reading [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). And instead of `ActiveWindow.Close` I recommend to `wn.Close SaveChanges:=False`. — Pᴇʜ, May 25 '21 at 11:42
Changing sh, does stille not work. Even if i set rng as the range it will not work even without select. I get subscript out of range — FLem Fken, May 25 '21 at 12:10
@FLemFken what is the exact code of the line when the error occurs? — Pᴇʜ, May 25 '21 at 12:16

score 0 · Accepted Answer · answered May 25 '21 at 12:54

If your data placed in the ListObject, it's simpler to use Range of ListObject:

Option Explicit

Function Race()
    Dim wn As Workbook, sh As Worksheet, rng As Range
    
    ActiveWorkbook.Worksheets(Array("GP", "F1")).Copy   ' into the automatically added WB
    Set wn = ActiveWorkbook ' new WB is active
    
    For Each sh In wn.Worksheets
        Set rng = sh.ListObjects(1).Range
        sh.ListObjects(1).Unlist
        With rng
            .Value = .Value
            .Interior.ColorIndex = xlColorIndexNone
            .Font.ColorIndex = xlColorIndexAutomatic
            .Borders.LineStyle = xlLineStyleNone
            Intersect(rng(1).EntireRow, rng).Borders.LineStyle = xlContinuous
        End With
        sh.Activate
        sh.Range("A1").Select
    Next sh
    
    wn.SaveAs "Q:\Racing\Results\" & Format(Date, "DDMMYY") & _
              " Grand prix & Formula1" & ".xlsx"
    wn.Close False
End Function

score 0 · Answer 2 · answered May 25 '21 at 12:59

Option Explicit

Public Sub Race()
    
    
    Dim wo As Workbook
    Set wo = ActiveWorkbook
    
    Dim wn As Workbook
    Set wn = Workbooks.Add
    
    Dim MyArray As Variant
    MyArray = Array("GP", "F1")
    
    Dim key As Variant
    For Each key In MyArray
        wo.Sheets(key).Copy before:=wn.Sheets(1)
    Next key
    
    Dim WSheet As Worksheet
    For Each WSheet In wn.Worksheets
    
        With WSheet
            .ListObjects.Item(1).Unlist
            .UsedRange.value = .UsedRange.value
            
            With .Range("A30:N100000")
                .Interior.ColorIndex = xlColorIndexNone
                .Font.ColorIndex = xlColorIndexAutomatic
                .Borders.LineStyle = xlLineStyleNone
            End With
            
            .Range("A30:N30").Borders.LineStyle = xlContinuous
            
        End With
        
    Next WSheet
    
    wn.SaveAs FileName:= _
              ("Q:\Racing\Results\" & Format(Date, "DDMMYY") & " Grand prix & Formula1" & ".xlsx")
    wn.Close , savechanges:=False
End Sub

Change Function to Subroutine
Loop through the Array to copy the sheets based on values in array
Use with on Wsheet and then use another with for Specific range
Remove redundant Select operations.

Formatting range for each sheet in array

2 Answers2