Creepy-crawly code on my tablets

Big Lar · Aug 12, 2015

My Windows8.1 tablets operate with Intel Atom @ 1.33GHz and 2GB of RAM
This code required nearly 30 seconds to process. Add six nearly identical Subs, and the wait is almost unbearable.

I’ve improved the speed by about 50% by changing:
lr = 100
to
lr = Sheets("Settings").[C12] with [C12]=COUNTA(GROSS!A3:A150)+3

Any suggestions on how to “quicken the pace”?

Thanks for looking!

Code:

  [FONT='inherit']Sub MacroFormat_GrossFlights()[/FONT]
  
  
  [FONT='inherit']Dim vals(17) As Variant[/FONT]
  [FONT='inherit']Dim lr As Long, i As Long, iRow As Long, ab As Long, j As Long, lkrange As Range, X, Z, Y As Variant, k As Integer[/FONT]
  [FONT='inherit']Dim temp[/FONT]
  
  [FONT='inherit']lr = Sheets("Settings").[C12][/FONT]
  
  [FONT='inherit']If Sheets("Settings").[A47].Value > 2 Then[/FONT]
  [FONT='inherit']Select Case Val(UserFormPostScores.TextBox39.Value)[/FONT]
  
  [FONT='inherit']           Case Is = 3[/FONT]
  [FONT='inherit']            Set ws = Sheets("SkinsG3")[/FONT]
  [FONT='inherit']        Case Is = 2[/FONT]
  [FONT='inherit']            Set ws = Sheets("SkinsG2")[/FONT]
  [FONT='inherit']        Case Else[/FONT]
  [FONT='inherit']            Set ws = Sheets("SkinsG1")[/FONT]
  [FONT='inherit']    End Select[/FONT]
  
  [FONT='inherit']    Else[/FONT]
  [FONT='inherit']Select Case Val(UserFormPostScores.TextBox39.Value)[/FONT]
  [FONT='inherit']        Case Is = 3[/FONT]
  [FONT='inherit']            Set ws = Sheets("SkinsG2")[/FONT]
  [FONT='inherit']        Case Is = 2[/FONT]
  [FONT='inherit']            Set ws = Sheets("SkinsG2")[/FONT]
  [FONT='inherit']        Case Else[/FONT]
  [FONT='inherit']            Set ws = Sheets("SkinsG1")[/FONT]
  [FONT='inherit']    End Select[/FONT]
  [FONT='inherit']    End If[/FONT]
  
  [FONT='inherit']FullPlayerName = UserFormPostScores.ComboBox1.Value[/FONT]
  [FONT='inherit']    Set CLoc = ws.Columns("A:A").Find(What:=FullPlayerName, After:=ws.Cells(10, 1), LookIn:= _[/FONT]
  [FONT='inherit']                            xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:= _[/FONT]
  [FONT='inherit']                            xlNext, MatchCase:=False, SearchFormat:=False)[/FONT]
  [FONT='inherit']    If CLoc Is Nothing Then[/FONT]
  [FONT='inherit']        iRow = ws.Cells(Rows.Count, 1) _[/FONT]
  [FONT='inherit']               .End(xlUp).Offset(1, 0).Row[/FONT]
  [FONT='inherit']    Else[/FONT]
  [FONT='inherit']        iRow = CLoc.Row[/FONT]
  [FONT='inherit']    End If[/FONT]
  [FONT='inherit']With ws[/FONT]
  
  [FONT='inherit']If UserFormPostScores.Label28.Caption <> "x" Then[/FONT]
  
  [FONT='inherit']ws.Cells(iRow, 1).Value = UserFormPostScores.ComboBox1.Value[/FONT]
  [FONT='inherit']ws.Cells(iRow, 2).Value = UserFormPostScores.TextBox4.Value[/FONT]
  [FONT='inherit']ws.Cells(iRow, 3).Value = UserFormPostScores.TextBox5.Value[/FONT]
  [FONT='inherit']ws.Cells(iRow, 4).Value = UserFormPostScores.TextBox6.Value[/FONT]
  [FONT='inherit']ws.Cells(iRow, 5).Value = UserFormPostScores.TextBox7.Value[/FONT]
  [FONT='inherit']ws.Cells(iRow, 6).Value = UserFormPostScores.TextBox8.Value[/FONT]
  [FONT='inherit']ws.Cells(iRow, 7).Value = UserFormPostScores.TextBox9.Value[/FONT]
  [FONT='inherit']ws.Cells(iRow, 8).Value = UserFormPostScores.TextBox10.Value[/FONT]
  [FONT='inherit']ws.Cells(iRow, 9).Value = UserFormPostScores.TextBox11.Value[/FONT]
  [FONT='inherit']ws.Cells(iRow, 10).Value = UserFormPostScores.TextBox12.Value[/FONT]
  [FONT='inherit']ws.Cells(iRow, 11).Value = UserFormPostScores.TextBox22.Value[/FONT]
  [FONT='inherit']ws.Cells(iRow, 12).Value = UserFormPostScores.TextBox13.Value[/FONT]
  [FONT='inherit']ws.Cells(iRow, 13).Value = UserFormPostScores.TextBox14.Value[/FONT]
  [FONT='inherit']ws.Cells(iRow, 14).Value = UserFormPostScores.TextBox15.Value[/FONT]
  [FONT='inherit']ws.Cells(iRow, 15).Value = UserFormPostScores.TextBox16.Value[/FONT]
  [FONT='inherit']ws.Cells(iRow, 16).Value = UserFormPostScores.TextBox17.Value[/FONT]
  [FONT='inherit']ws.Cells(iRow, 17).Value = UserFormPostScores.TextBox18.Value[/FONT]
  [FONT='inherit']ws.Cells(iRow, 18).Value = UserFormPostScores.TextBox19.Value[/FONT]
  [FONT='inherit']ws.Cells(iRow, 19).Value = UserFormPostScores.TextBox20.Value[/FONT]
  [FONT='inherit']ws.Cells(iRow, 20).Value = UserFormPostScores.TextBox21.Value[/FONT]
  [FONT='inherit']ws.Cells(iRow, 21).Value = UserFormPostScores.TextBox23.Value[/FONT]
  
  [FONT='inherit']ws.Cells(iRow, 22).Value = UserFormPostScores.TextBox24.Value[/FONT]
  [FONT='inherit']ws.Cells(iRow, 23).Value = ws.Cells(iRow, 15).Value + ws.Cells(iRow, 16).Value + ws.Cells(iRow, 17).Value _[/FONT]
  [FONT='inherit']    + ws.Cells(iRow, 18).Value + ws.Cells(iRow, 19).Value + ws.Cells(iRow, 20).Value[/FONT]
  
  [FONT='inherit']ws.Cells(iRow, 24).Value = ws.Cells(iRow, 18).Value + ws.Cells(iRow, 19).Value + ws.Cells(iRow, 20).Value[/FONT]
  
  [FONT='inherit']ws.Cells(iRow, 25).Value = ws.Cells(iRow, 5).Value + ws.Cells(iRow, 6).Value + ws.Cells(iRow, 7).Value _[/FONT]
  [FONT='inherit']    + ws.Cells(iRow, 8).Value + ws.Cells(iRow, 9).Value + ws.Cells(iRow, 10).Value[/FONT]
  
  [FONT='inherit']ws.Cells(iRow, 26).Value = ws.Cells(iRow, 8).Value + ws.Cells(iRow, 9).Value + ws.Cells(iRow, 10).Value[/FONT]
  
  [FONT='inherit']Else[/FONT]
  [FONT='inherit']ws.Cells(iRow, 1).Value = UserFormPostScores.ComboBox1.Value[/FONT]
  [FONT='inherit']End If[/FONT]
  [FONT='inherit']'End With[/FONT]
  
  
  [FONT='inherit']For i = 1 To Sheets("Settings").[A47].Value[/FONT]
  [FONT='inherit']Sheets("SkinsG" & i).Select[/FONT]
  [FONT='inherit']ActiveSheet.Sort.SortFields.Clear[/FONT]
  
  [FONT='inherit']ActiveSheet.Sort.SortFields.Add Key:=Range("V3:V150"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal[/FONT]
  [FONT='inherit']ActiveSheet.Sort.SortFields.Add Key:=Range("V3:V150"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal[/FONT]
  [FONT='inherit']ActiveSheet.Sort.SortFields.Add Key:=Range("U3:U150"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal[/FONT]
  [FONT='inherit']ActiveSheet.Sort.SortFields.Add Key:=Range("W3:W150"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal[/FONT]
  [FONT='inherit']ActiveSheet.Sort.SortFields.Add Key:=Range("X3:X150"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal[/FONT]
  [FONT='inherit']ActiveSheet.Sort.SortFields.Add Key:=Range("K3:K150"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal[/FONT]
  [FONT='inherit']ActiveSheet.Sort.SortFields.Add Key:=Range("Y3:Y150"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal[/FONT]
  [FONT='inherit']ActiveSheet.Sort.SortFields.Add Key:=Range("Z3:Z150"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal[/FONT]
  
  [FONT='inherit']With ActiveSheet.Sort[/FONT]
  [FONT='inherit'].SetRange Range("A3:Z150")[/FONT]
  [FONT='inherit']  .Header = xlNo[/FONT]
  [FONT='inherit']   .MatchCase = False[/FONT]
  [FONT='inherit']    .Orientation = xlTopToBottom[/FONT]
  [FONT='inherit']     .SortMethod = xlPinYin[/FONT]
  [FONT='inherit']      .Apply[/FONT]
  [FONT='inherit']    End With[/FONT]
  [FONT='inherit']ActiveSheet.Columns("A").AutoFit[/FONT]
  
  [FONT='inherit']Range(Cells(3, 2), Cells(lr, 22)).ClearFormats[/FONT]
  [COLOR=#ff0000]
[/COLOR]
[COLOR=#ff0000][FONT='inherit']‘’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’[/FONT][/COLOR]
  [COLOR=#ff0000][FONT='inherit']‘Slow down begins here![/FONT][/COLOR]

  

  [FONT='inherit']For j = 2 To 21[/FONT]
  [FONT='inherit']Set lkrange = Range(Cells(3, j), Cells(lr, j))[/FONT]
  [FONT='inherit']M = Application.WorksheetFunction.Min(lkrange)[/FONT]
  
  [FONT='inherit']For ab = 3 To lr[/FONT]
  [FONT='inherit']If Cells(ab, j) = M Then[/FONT]
  
  [FONT='inherit']With Cells(ab, j)[/FONT]
  [FONT='inherit']'.Font.Bold = True[/FONT]
  [FONT='inherit'] .Font.Color = vbRed[/FONT]
  [FONT='inherit']  .HorizontalAlignment = xlCenter[/FONT]
  [FONT='inherit']   .VerticalAlignment = xlCenter[/FONT]
  [FONT='inherit']      End With[/FONT]
  [FONT='inherit']    End If[/FONT]
  [FONT='inherit']  Next[/FONT]
  [FONT='inherit']Next[/FONT]
  
  [FONT='inherit']For k = 2 To 21[/FONT]
  [FONT='inherit']    Set lkrange = Range(Cells(3, k), Cells(lr, k))[/FONT]
  [FONT='inherit']    X = Application.WorksheetFunction.Min(lkrange)[/FONT]
  [FONT='inherit']    Z = Application.WorksheetFunction.CountIf(lkrange, X)[/FONT]
  
  [FONT='inherit']    If Z = 1 Then[/FONT]
  [FONT='inherit']        Y = Application.WorksheetFunction.Match(X, lkrange, 0)[/FONT]
  [FONT='inherit']        With Cells(Y + 2, k)[/FONT]
  [FONT='inherit']            .Font.Italic = True[/FONT]
  [FONT='inherit']             .Font.Bold = True[/FONT]
  [FONT='inherit']               .Font.Size = 12[/FONT]
  [FONT='inherit']                .Interior.Color = 255[/FONT]
  [FONT='inherit']                 .Font.ThemeColor = xlThemeColorDark1[/FONT]
  [FONT='inherit']                  .HorizontalAlignment = xlCenter[/FONT]
  [FONT='inherit']                   .VerticalAlignment = xlCenter[/FONT]
  [FONT='inherit']        End With[/FONT]
  [FONT='inherit']    End If[/FONT]
  
  [FONT='inherit']With Cells 'ActiveSheet[/FONT]
  [FONT='inherit']Range(Cells(3, 11), Cells(lr, 11)).ClearFormats[/FONT]
  [FONT='inherit']Range(Cells(3, 21), Cells(lr, 21)).ClearFormats[/FONT]
  
  [FONT='inherit']Range(Cells(3, 2), Cells(lr, 26)).HorizontalAlignment = xlCenter[/FONT]
  [FONT='inherit']Range(Cells(3, 2), Cells(lr, 26)).VerticalAlignment = xlCenter[/FONT]
  
  [FONT='inherit']If Range("B3").Value >= "*" Then[/FONT]
  [FONT='inherit']Range("B3:Z40").SpecialCells(xlCellTypeConstants).Borders.ColorIndex = 1[/FONT]
  [FONT='inherit']Else[/FONT]
  [FONT='inherit']End If[/FONT]
  
  [FONT='inherit']Range("W3:Z40").Font.Size = 4[/FONT]
  
  [FONT='inherit']End With[/FONT]
  
  [FONT='inherit']Next[/FONT]
  [FONT='inherit']Next i[/FONT]
  
  [FONT='inherit']End With[/FONT]
  [FONT='inherit']Range("A1").Select[/FONT]
  
  [FONT='inherit']End Sub[/FONT]

ImranMalek · Aug 13, 2015

Hi,

Unfortunately I can't replicate your code but you can try these things to speed up your code

Turn off the automatic calculation while formatting with Application.Calculation = xlCalculationManual
Stop Events with Application.EnableEvents = False
Declare the variables with correct data types
Try not to select anything unless you have to
Club multiple statements into one by using :

Hope it helps!

brucef2112 · Aug 13, 2015

I'll prefrence this with;
I have an older version of Excel so some of the sort/format stuff i had to step over.
Obviously I don't have your UserForm, so I did my best guess at what is in the sheets and stepped over it (I assume it is good).

With that in mind, I came up with this code which seems to work like your original posted code.
I have a Core i7 so I can't tell the difference of speed. You'll have to test it yourself.

Some basic things i found. You are walking through the column and cell ranges twice to set cell format properties. I reduce this to once through the cells, so technically it is twice as fast for that section of code.

Also you were repeatedly setting boarder properties after every column loop. So a bit of a time killer there. I changed it so it does the format one time after it finishes the sheet.

You had the loop setting the cell's font properties on each loop. This takes time. It is better to just collect the addresses into a Range and then after the loop is finished, set the format properties to the range(containing all the target cells) in one call. ie do it once on the range instead of repeatedly setting them on each cell one at a time as you loop through.

Also check the code for some comments I made. I don't know the specifics of the logic but I think there may be some typos. Look for the remarks. It's up to you to decide if its OK or not.

Not a biggie, but also found some variables that were not DIM'd and a few orphans.
I did add a few more vars to make this work.

I don't know what your sheet looks like but I assume there are column headers in your sheets.
And as such, this code is based on there being column headers. If you don't have column headers then you'll have to create some or else this code isn't for you.
The need for column headers is because this code uses the the AutoFilter to find the cells that need to be formatted, without having to loop through each cell to find the cells with the matching value.

Give it a try;

Code:

Sub MacroFormat_GrossFlights()
    Dim lr As Long, i As Long, iRow As Long, ab As Long, j As Long, X As Long, Y As Long, Z As Long
    Dim lkrange As Range
    Dim m As Long
    Dim lastrow As Long
    Dim rFrmtTheseCells As Range, rFrmtTheseCellsToo As Range
    Dim FullPlayerName As String
    Dim r1 As Range
    Dim ws As Worksheet
    Dim rFoundCell As Range
    lr = Sheets("Settings").[C12]
    
    If Sheets("Settings").[A47].Value > 2 Then
        Select Case Val(UserFormPostScores.TextBox39.Value)
            Case Is = 3
                Set ws = Sheets("SkinsG3")
            Case Is = 2
                Set ws = Sheets("SkinsG2")
            Case Else
                Set ws = Sheets("SkinsG1")
        End Select
      
    Else
        Select Case Val(UserFormPostScores.TextBox39.Value)
            Case Is = 3
                Set ws = Sheets("SkinsG2") ' <is this="" a="" typo?="" or="" is="" logic="" suppose="" to="" be="" 'if="" case="" equals="" 3="" 2="" return="" reference="" skinsg2'.
            Case Is = 2
                Set ws = Sheets("SkinsG2")
            Case Else
                Set ws = Sheets("SkinsG1")
        End Select
    End If
    
    FullPlayerName = UserFormPostScores.ComboBox1.Value
    Set CLoc = ws.Columns("A:A").Find(What:=FullPlayerName, After:=ws.Cells(10, 1), LookIn:= _
                              xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:= _
                              xlNext, MatchCase:=False, SearchFormat:=False)
    If CLoc Is Nothing Then
        iRow = ws.Cells(Rows.Count, 1) _
                 .End(xlUp).Offset(1, 0).Row
    Else
        iRow = CLoc.Row
    End If
    
    If UserFormPostScores.Label28.Caption <> "x" Then
        With ws
            .Cells(iRow, 1) = UserFormPostScores.ComboBox1
            .Cells(iRow, 2) = UserFormPostScores.TextBox4
            .Cells(iRow, 3) = UserFormPostScores.TextBox5
            .Cells(iRow, 4) = UserFormPostScores.TextBox6
            .Cells(iRow, 5) = UserFormPostScores.TextBox7
            .Cells(iRow, 6) = UserFormPostScores.TextBox8
            .Cells(iRow, 7) = UserFormPostScores.TextBox9
            .Cells(iRow, 8) = UserFormPostScores.TextBox10
            .Cells(iRow, 9) = UserFormPostScores.TextBox11
            .Cells(iRow, 10) = UserFormPostScores.TextBox12
            .Cells(iRow, 11) = UserFormPostScores.TextBox22
            .Cells(iRow, 12) = UserFormPostScores.TextBox13
            .Cells(iRow, 13) = UserFormPostScores.TextBox14
            .Cells(iRow, 14) = UserFormPostScores.TextBox15
            .Cells(iRow, 15) = UserFormPostScores.TextBox16
            .Cells(iRow, 16) = UserFormPostScores.TextBox17
            .Cells(iRow, 17) = UserFormPostScores.TextBox18
            .Cells(iRow, 18) = UserFormPostScores.TextBox19
            .Cells(iRow, 19) = UserFormPostScores.TextBox20
            .Cells(iRow, 20) = UserFormPostScores.TextBox21
            .Cells(iRow, 21) = UserFormPostScores.TextBox23
            
            .Cells(iRow, 22) = UserFormPostScores.TextBox24
            .Cells(iRow, 23) = .Cells(iRow, 15) + .Cells(iRow, 16) + .Cells(iRow, 17) _
                + .Cells(iRow, 18) + .Cells(iRow, 19) + .Cells(iRow, 20)
            
            .Cells(iRow, 24) = .Cells(iRow, 18) + .Cells(iRow, 19) + .Cells(iRow, 20)
            
            .Cells(iRow, 25) = .Cells(iRow, 5) + .Cells(iRow, 6) + .Cells(iRow, 7) _
                + .Cells(iRow, 8) + .Cells(iRow, 9) + .Cells(iRow, 10)
            
            .Cells(iRow, 26) = .Cells(iRow, 8) + .Cells(iRow, 9) + .Cells(iRow, 10)
        End With
    Else
        ws.Cells(iRow, 1).Value = UserFormPostScores.ComboBox1.Value
    End If
    
    For i = 1 To Sheets("Settings").[A47].Value
            
        With Worksheets("SkinsG" & i)
            Worksheets("SkinsG" & i).Select
            With .Sort
                .sortfields.Clear
                ' Did you mean to do this or is it a typo? These first two SORTS are referencing the same "V3:V150" range
                .sortfields.Add Key:=Range("V3:V150"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                .sortfields.Add Key:=Range("V3:V150"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                .sortfields.Add Key:=Range("U3:U150"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                .sortfields.Add Key:=Range("W3:W150"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                .sortfields.Add Key:=Range("X3:X150"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                .sortfields.Add Key:=Range("K3:K150"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                .sortfields.Add Key:=Range("Y3:Y150"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                .sortfields.Add Key:=Range("Z3:Z150"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                
                .SetRange Range("A3:Z150")
                .Header = xlNo
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With 'Sort
            
            .Columns("A").AutoFit
            
            .Range(Cells(3, 2), Cells(lr, 22)).ClearFormats
            
' ’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’
        'Slow down begins here!
            
            Set r1 = .Range(Cells(1, 1), Cells(lr, 21))
            
            For j = 2 To 21
                Set lkrange = .Range(Cells(3, j), Cells(lr, j))
                m = Application.WorksheetFunction.Min(lkrange)
                X = Application.WorksheetFunction.Min(lkrange)
                Z = Application.WorksheetFunction.CountIf(lkrange, X)
                
                .AutoFilterMode = False
                r1.AutoFilter
                r1.AutoFilter field:=j, Criteria1:=m
                lastrow = Cells(.Rows.Count, j).End(xlUp).Row
                If lastrow > 1 Then
                    Set rFoundCell = Range(Cells(3, j), Cells(lastrow, j)).SpecialCells(xlCellTypeVisible)
                    
                    If rFrmtTheseCells Is Nothing Then
                        Set rFrmtTheseCells = rFoundCell
                    Else
                        Set rFrmtTheseCells = Union(rFrmtTheseCells, rFoundCell)
                    End If
                End If
                
                ActiveSheet.AutoFilterMode = False
                
                If X > 0 Then Y = Application.WorksheetFunction.Match(X, lkrange, 0)
                
                If Z = 1 Then
                    If rFrmtTheseCellsToo Is Nothing Then
                        Set rFrmtTheseCellsToo = .Cells(Y + 2, j)
                    Else
                        Set rFrmtTheseCellsToo = Union(rFrmtTheseCellsToo, .Cells(Y + 2, j))
                    End If
                End If
                
            Next j
            ' Format the LOWEST value cells that were found above, all at one time.
            With rFrmtTheseCells.Cells
                .Font.Color = vbRed
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With
            
            ' Format the Single count MIN cells that were found above, all at one time.
            With rFrmtTheseCellsToo
                .Font.Italic = True
                .Font.Bold = True
                .Font.Size = 12
                .Interior.Color = 55 ' 255
                .Font.ThemeColor = xlThemeColorDark1
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With
                        
            .Range(Cells(3, 11), Cells(lr, 11)).ClearFormats
            .Range(Cells(3, 21), Cells(lr, 21)).ClearFormats
            
            .Range(Cells(3, 2), Cells(lr, 26)).HorizontalAlignment = xlCenter
            .Range(Cells(3, 2), Cells(lr, 26)).VerticalAlignment = xlCenter
            If .Range("B3").Value >= "*" Then
                    .Range("B3:Z40").SpecialCells(xlCellTypeConstants).Borders.ColorIndex = 1
            End If
            
            .Range("W3:Z40").Font.Size = 4
        End With
        
        Set rFrmtTheseCells = Nothing
        Set rFrmtTheseCellsToo = Nothing
        Set lkrange = Nothing
        
    Next i
    
    ws.Select
    ws.Range("A1").Select
    Set ws = Nothing
    MsgBox "Finished"
    
End Sub

</is>

Big Lar · Aug 15, 2015

brucef2112,
Wow!
Go away for a little R&R, and come back to find this!
Thanks for the terrific assistance!
I'll have time to work on in in a few days...but, wow!
I'll let you know how it functions.
Thanks again,
Big Lar

Big Lar · Aug 16, 2015

brucef2112,
Thank you for your assistance. Your efforts to resolve my issue was completely unexpected and greatly appreciated. Your grasp of the “language” and willingness to assist is astonishing…to me.

I have begun revising large portions of my project because of your input.

Adjustments were needed to:

Account for the First 2 rows of my worksheet being used as header rows.
Populate the worksheet with the UserForm Data
Get the code to “do the math” for the last 4 lines of ws Values
And, finally, reformat the header rows and remaining sheet Black Font. (I looked and looked for it…so, workaround)

Anyway, I know I’ve gushed about you fabulous assistance but,
THANKS, AGAIN!

Here is your code, with my “adjustments”. It works marvelously!

Rich (BB code):

  Sub MacroFormat_GrossFlights()
      Dim lr As Long, i As Long, iRow As Long, ab As Long, j As Long, X As Long, Y As Long, Z As Long
      Dim lkrange As Range
      Dim m As Long
      Dim lastrow As Long
      Dim rFrmtTheseCells As Range, rFrmtTheseCellsToo As Range
      Dim FullPlayerName As String
      Dim r1 As Range
      Dim ws As Worksheet
      Dim rFoundCell As Range
      lr = Sheets("Settings").[C12]
      
   
  If Sheets("Settings").[A47] > 2 Then
      Select Case Val(UserFormPostScores.TextBox39.Value)
          Case Is = 3
              Set ws = Sheets("SkinsG3")
          Case Is = 2
                  Set ws = Sheets("SkinsG2")
          Case Else
                  Set ws = Sheets("SkinsG1")
          End Select
      Else
      
          Select Case Val(UserFormPostScores.TextBox39.Value)
              Case Is = 3
             Set ws = Sheets("SkinsG2")
          Case Is = 2
              Set ws = Sheets("SkinsG2")
          Case Else
              Set ws = Sheets("SkinsG1")
      End Select
      End If
   
   
  ws.Select
  With ws
   
   
  'This allows correcting input and by finding name or adding new name
  FullPlayerName = UserFormPostScores.ComboBox1.Value
      Set CLoc = ws.Columns("A:A").Find(What:=FullPlayerName, After:=ws.Cells(10, 1), LookIn:= _
                              xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:= _
                              xlNext, MatchCase:=False, SearchFormat:=False)
      If CLoc Is Nothing Then
          iRow = ws.Cells(Rows.Count, 1) _
                 .End(xlUp).Offset(1, 0).Row
      Else
          iRow = CLoc.Row
      End If
  End With
   
  With ws
   
  If UserFormPostScores.Label28.Caption <> "x" Then
  ws.Cells(iRow, 1).Value = UserFormPostScores.ComboBox1.Value
  ws.Cells(iRow, 2).Value = UserFormPostScores.TextBox4.Value
  ws.Cells(iRow, 3).Value = UserFormPostScores.TextBox5.Value
  ws.Cells(iRow, 4).Value = UserFormPostScores.TextBox6.Value
  ws.Cells(iRow, 5).Value = UserFormPostScores.TextBox7.Value
  ws.Cells(iRow, 6).Value = UserFormPostScores.TextBox8.Value
  ws.Cells(iRow, 7).Value = UserFormPostScores.TextBox9.Value
  ws.Cells(iRow, 8).Value = UserFormPostScores.TextBox10.Value
  ws.Cells(iRow, 9).Value = UserFormPostScores.TextBox11.Value
  ws.Cells(iRow, 10).Value = UserFormPostScores.TextBox12.Value
  ws.Cells(iRow, 11).Value = UserFormPostScores.TextBox22.Value
  ws.Cells(iRow, 12).Value = UserFormPostScores.TextBox13.Value
  ws.Cells(iRow, 13).Value = UserFormPostScores.TextBox14.Value
  ws.Cells(iRow, 14).Value = UserFormPostScores.TextBox15.Value
  ws.Cells(iRow, 15).Value = UserFormPostScores.TextBox16.Value
  ws.Cells(iRow, 16).Value = UserFormPostScores.TextBox17.Value
  ws.Cells(iRow, 17).Value = UserFormPostScores.TextBox18.Value
  ws.Cells(iRow, 18).Value = UserFormPostScores.TextBox19.Value
  ws.Cells(iRow, 19).Value = UserFormPostScores.TextBox20.Value
  ws.Cells(iRow, 20).Value = UserFormPostScores.TextBox21.Value
  ws.Cells(iRow, 21).Value = UserFormPostScores.TextBox23.Value
  ws.Cells(iRow, 22).Value = UserFormPostScores.TextBox24.Value
   
  '''Had to use "ws.Cells" to get math results here
   
  ws.Cells(iRow, 23).Value = ws.Cells(iRow, 15).Value + ws.Cells(iRow, 16).Value + ws.Cells(iRow, 17).Value _
      + ws.Cells(iRow, 18).Value + ws.Cells(iRow, 19).Value + ws.Cells(iRow, 20).Value
   
  ws.Cells(iRow, 24).Value = ws.Cells(iRow, 18).Value + ws.Cells(iRow, 19).Value + ws.Cells(iRow, 20).Value
   
  ws.Cells(iRow, 25).Value = ws.Cells(iRow, 5).Value + ws.Cells(iRow, 6).Value + ws.Cells(iRow, 7).Value _
      + ws.Cells(iRow, 8).Value + ws.Cells(iRow, 9).Value + ws.Cells(iRow, 10).Value
   
  ws.Cells(iRow, 26).Value = ws.Cells(iRow, 8).Value + ws.Cells(iRow, 9).Value + ws.Cells(iRow, 10).Value
   
  Else
  ws.Cells(iRow, 1).Value = UserFormPostScores.ComboBox1.Value
  End If
   
   
              With ws.Sort
                  .SortFields.Clear
                  .SortFields.Add Key:=Range("V3:V150"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                  .SortFields.Add Key:=Range("U3:U150"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                  .SortFields.Add Key:=Range("W3:W150"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                  .SortFields.Add Key:=Range("X3:X150"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                  .SortFields.Add Key:=Range("K3:K150"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                  .SortFields.Add Key:=Range("Y3:Y150"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                  .SortFields.Add Key:=Range("Z3:Z150"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                  
                  .SetRange Range("A3:Z150")
                  .Header = xlNo
                  .MatchCase = False
                  .Orientation = xlTopToBottom
                  .SortMethod = xlPinYin
                  .Apply
              End With 'Sort
              
  With ws
              .Columns("A").AutoFit
              .Range(Cells(3, 2), Cells(lr, 22)).ClearFormats
              End With 'reformat
   
   
   
  Application.Calculation = xlCalculationManual ' Suggested for speeding process
   
              Set r1 = .Range(Cells(2, 1), Cells(lr, 21))
              
              For j = 2 To 21
                  Set lkrange = .Range(Cells(3, j), Cells(lr, j))
                  m = Application.WorksheetFunction.Min(lkrange)
                  X = Application.WorksheetFunction.Min(lkrange)
                  Z = Application.WorksheetFunction.CountIf(lkrange, X)
                  
                  .AutoFilterMode = False
                  r1.AutoFilter
                  r1.AutoFilter field:=j, Criteria1:=m
                  lastrow = Cells(.Rows.Count, j).End(xlUp).Row
                  If lastrow > 1 Then
                      Set rFoundCell = Range(Cells(3, j), Cells(lastrow, j)).SpecialCells(xlCellTypeVisible)
   
                      If rFrmtTheseCells Is Nothing Then
                          Set rFrmtTheseCells = rFoundCell
                      Else
                          Set rFrmtTheseCells = Union(rFrmtTheseCells, rFoundCell)
                      End If
                  End If
                  
                  ActiveSheet.AutoFilterMode = False
                  
                  If X > 0 Then Y = Application.WorksheetFunction.Match(X, lkrange, 0)
                                  
                  If Z = 1 Then
                      If rFrmtTheseCellsToo Is Nothing Then
                          Set rFrmtTheseCellsToo = .Cells(Y + 2, j)
                      Else
                          Set rFrmtTheseCellsToo = Union(rFrmtTheseCellsToo, .Cells(Y + 2, j))
                      End If
                  End If
                  
              Next j
              ' Format the LOWEST value cells that were found above, all at one time.
              With rFrmtTheseCells.Cells
                  .Font.Color = vbRed
                  .HorizontalAlignment = xlCenter
                  .VerticalAlignment = xlCenter
              End With
              
              ' Format the Single count MIN cells that were found above, all at one time.
              With rFrmtTheseCellsToo
                  .Font.Italic = True
                  .Font.Bold = True
                  .Font.Size = 12
                  .Interior.Color = 255
                  .Font.ThemeColor = xlThemeColorDark1
                  .HorizontalAlignment = xlCenter
                  .VerticalAlignment = xlCenter
              End With
                          
              .Range(Cells(3, 11), Cells(lr, 11)).ClearFormats
              .Range(Cells(3, 21), Cells(lr, 21)).ClearFormats
              
              .Range(Cells(3, 2), Cells(lr, 26)).HorizontalAlignment = xlCenter
              .Range(Cells(3, 2), Cells(lr, 26)).VerticalAlignment = xlCenter
              If .Range("B3").Value >= "*" Then
                      .Range("B3:Z40").SpecialCells(xlCellTypeConstants).Borders.ColorIndex = 1
              End If
                          
  '''''''
  '  Code formats the entire sheet's Font=Red when only ("A3:Z50") should be Red Font, so...workaround,
              .Range("A1:Z2").Font.Color = vbBlack
              .Range("V1:BH50").Font.Color = vbBlack
  '''''''
              .Range("W3:Z40").Font.Size = 4
          End With
          
          Set rFrmtTheseCells = Nothing
          Set rFrmtTheseCellsToo = Nothing
          Set lkrange = Nothing
      
      ws.Select
      ws.Range("A1").Select
      Set ws = Nothing
      
  End Sub

brucef2112 · Aug 28, 2015

You are welcome! I'm glad it worked!

*bruce grabs some napkins and hands them to Big Lar to clean up gushing*

brucef2112 · Aug 28, 2015

Hey Big Lar,
I just took a look at your modified code and have some minor points about it.

I think there was an orphan 'With' missing an End With. This may have caused you to explicitly need to reference ws.cell in one area of your code.
In the very least, you had a 'With....End With' covering a large chunk of code and made it hard to follow the referenced 'ws' object.

I'm gonna guess from reading the code, you could use some help on the use of 'With....End With'.
This snippet is similar to code from your SUB. This is a mix of the Explicit and Implicit references to the worksheet object.

Code:

With ws
     ws.Range.DoThis
     ws.Range.DoThat
      .Range.DoOther
     .Select
End With

The purpose of the With...End With is to make your code run faster (very technical reason, understood only by propeller heads) and also easier to read.
The correct use of the Implicit reference is this. (This will run faster)WARNING: Don't ask a propeller head to explain why it is faster, it will put you to sleep!

Code:

With ws
     .Range.DoThis
     .Range.DoThat
     .Range.DoOther
     .Select
End With

The correct use of the Explicit reference is this. (Nothing really wrong, other than it runs a bit slower and you are also doing a bit more typing)

Code:

ws.Range.DoThis
ws.Range.DoThat
ws.Range.DoOther
ws.Select

See how your code was combining them together? Not good for the person writing or reading the code when there is a bunch of code in between.
And more importantly, the VBA interpreter can get confused as to what object it should work with. (most of the time it can figure it out)

So when to use one over the other other two, you ask?
Its a really good idea NOT to use the 'Lets mix them together' method! Choose one or the other.
The Implicit format (using the 'With...End With') is best when you're about to make a bunch of changes to the same object. such as when your code is formating cell's properties. Example

Code:

With rFrmtTheseCells
            .Font.Italic = True
            .Font.Bold = True
            .Font.Size = 12
            .Interior.Color = 255
            .Font.ThemeColor = xlThemeColorDark1
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With

Notice we are using the .Ref for the properties we are changing. VBA understands that all the .Refs are refering to the rFrmtTheseCells object (a bunch of cells).

If you just need to make one or two changes to an object, it is ok, and shorter, to use the Explicit reference to the object.
So if you just need to bold the font and set the color its shorter to just do this.

Code:

rFrmtTheseCells.Font.Bold = True
rFrmtTheseCells.Font.Color = 255

Keep in mind you don't want to do a "With' at the top of your SUB and have the matching 'End With' a mile down in your SUB. Its better to Chunk them with related actions.
So,

Code:

With X
   10 lines of code related to change a bunch o' stuff
end with
some other 20 lines of code doing blah, blah, blah
'need to do more stuff to X so start another With statement.
With X
   10 lines of code related to change a bunch o' stuff
end with

I went through your code you posted back and cleaned up the 'With...End With's. Included some comments to help understand.
Don't ditch your existing one that works!! Just take a look at my code below and test it. then make sure it makes sense to you what is happening.
Otherwise stick with the code you had and when you get some time, check online for exhaustive amount of info about 'With...End With'.

One other thing that really isn't a biggie on speed. But more of a coding style that saves some typing.
All objects have a default property. In the case of a CELL the default is its Value. Knowing the default properties of objects can can save you 10's of keystrokes.
Your code is setting the value of 22 cell's based on your user form which has as many text boxes (and 1 combo box).
Such as

Code:

.Cells(iRow, 1).Value = UserFormPostScores.textbox1.Value

For a single line seems silly and its OK but consider this;
This is shorter, does the same thing, and saves 264 key stokes to code the 22 lines.

Code:

.Cells(iRow, 1) = UserFormPostScores.textbox1

There are actually hundreds of more key strokes that could be eliminated in your one SUB. Over my years of coding this one thing has saved me 10's of thousand of key strokes.

There's a couple of other minor thing that could be changed but I'll skip them because they are more about personal coding style. One person likes it another one doesn't.

Happy coding.

Code:

Sub MacroFormat_GrossFlights()Dim lr As Long, i As Long, iRow As Long, ab As Long, j As Long, X As Long, Y As Long, Z As Long
Dim lkrange As Range
Dim m As Long
Dim lastrow As Long
Dim rFrmtTheseCells As Range, rFrmtTheseCellsToo As Range
Dim FullPlayerName As String
Dim r1 As Range
Dim ws As Worksheet
Dim rFoundCell As Range


    lr = Sheets("Settings").[C12]


    If Sheets("Settings").[A47] > 2 Then
        Select Case Val(UserFormPostScores.TextBox39.Value)
          Case Is = 3
              Set ws = Sheets("SkinsG3")
          Case Is = 2
                  Set ws = Sheets("SkinsG2")
          Case Else
                  Set ws = Sheets("SkinsG1")
          End Select
    Else
    
        Select Case Val(UserFormPostScores.TextBox39.Value)
          Case Is = 3
             Set ws = Sheets("SkinsG2")
          Case Is = 2
              Set ws = Sheets("SkinsG2")
          Case Else
              Set ws = Sheets("SkinsG1")
      End Select
    End If
    
    With ws 'notice we TAB indent the code in between the With....End With. This makes it easy to know what body of code is using the With statement.
        'This allows correcting input and by finding name or adding new name
        
        .Select
        
        FullPlayerName = UserFormPostScores.ComboBox1.Value
        Set CLoc = .Columns("A:A").Find(What:=FullPlayerName, After:=ws.Cells(10, 1), LookIn:= _
                    xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:= _
                    xlNext, MatchCase:=False, SearchFormat:=False)
        If CLoc Is Nothing Then
            iRow = .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        Else
            iRow = CLoc.Row
        End If
        
        If UserFormPostScores.Label28.Caption <> "x" Then 'note we TAB indent the code in between IF...Else...End IF so its easy to see what code is for each ELSE.
            .Cells(iRow, 1).Value = UserFormPostScores.ComboBox1.Value
            .Cells(iRow, 2).Value = UserFormPostScores.TextBox4.Value
            .Cells(iRow, 3).Value = UserFormPostScores.TextBox5.Value
            .Cells(iRow, 4).Value = UserFormPostScores.TextBox6.Value
            .Cells(iRow, 5).Value = UserFormPostScores.TextBox7.Value
            .Cells(iRow, 6).Value = UserFormPostScores.TextBox8.Value
            .Cells(iRow, 7).Value = UserFormPostScores.TextBox9.Value
            .Cells(iRow, 8).Value = UserFormPostScores.TextBox10.Value
            .Cells(iRow, 9).Value = UserFormPostScores.TextBox11.Value
            .Cells(iRow, 10).Value = UserFormPostScores.TextBox12.Value
            .Cells(iRow, 11).Value = UserFormPostScores.TextBox22.Value
            .Cells(iRow, 12).Value = UserFormPostScores.TextBox13.Value
            .Cells(iRow, 13).Value = UserFormPostScores.TextBox14.Value
            .Cells(iRow, 14).Value = UserFormPostScores.TextBox15.Value
            .Cells(iRow, 15).Value = UserFormPostScores.TextBox16.Value
            .Cells(iRow, 16).Value = UserFormPostScores.TextBox17.Value
            .Cells(iRow, 17).Value = UserFormPostScores.TextBox18.Value
            .Cells(iRow, 18).Value = UserFormPostScores.TextBox19.Value
            .Cells(iRow, 19).Value = UserFormPostScores.TextBox20.Value
            .Cells(iRow, 20).Value = UserFormPostScores.TextBox21.Value
            .Cells(iRow, 21).Value = UserFormPostScores.TextBox23.Value
            .Cells(iRow, 22).Value = UserFormPostScores.TextBox24.Value
            
            '''Had to use "ws.Cells" to get math results here
             
            .Cells(iRow, 23).Value = .Cells(iRow, 15).Value + .Cells(iRow, 16).Value + .Cells(iRow, 17).Value _
                + .Cells(iRow, 18).Value + .Cells(iRow, 19).Value + .Cells(iRow, 20).Value
             
            .Cells(iRow, 24).Value = .Cells(iRow, 18).Value + .Cells(iRow, 19).Value + .Cells(iRow, 20).Value
             
            .Cells(iRow, 25).Value = .Cells(iRow, 5).Value + .Cells(iRow, 6).Value + .Cells(iRow, 7).Value _
                + .Cells(iRow, 8).Value + .Cells(iRow, 9).Value + .Cells(iRow, 10).Value
             
            .Cells(iRow, 26).Value = .Cells(iRow, 8).Value + .Cells(iRow, 9).Value + .Cells(iRow, 10).Value
             
        Else
            .Cells(iRow, 1).Value = UserFormPostScores.ComboBox1.Value
        End If
        
    End With ' matches up with the 'With ws which covers from Get fulluser name, to setting the cell values related to the user form.
             ' Best to end the 'With ws' here because the following code is working with the 'Sort' object.


    With ws.Sort 'Note, how easy it is to see what code is related to the 'ws.Sort' when using TAB indent of the related code.
        .SortFields.Clear
        .SortFields.Add Key:=Range("V3:V150"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("U3:U150"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("W3:W150"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("X3:X150"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("K3:K150"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("Y3:Y150"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=Range("Z3:Z150"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        
        .SetRange Range("A3:Z150")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With ' for ws.Sort
        
    ' We are about to do a bunch of stuff with the 'ws' so lets start another 'With ws' so we can use the .Ref to its objects and properties.
    With ws
        .Columns("A").AutoFit
        .Range(Cells(3, 2), Cells(lr, 22)).ClearFormats
        ' There are more .Ref below so we'll move this 'End With' further down.
        'End With 'reformat
        
        Application.Calculation = xlCalculationManual ' Suggested for speeding process
        
        Set r1 = .Range(Cells(2, 1), Cells(lr, 21))
        
        For j = 2 To 21
            Set lkrange = .Range(Cells(3, j), Cells(lr, j))
            m = Application.WorksheetFunction.Min(lkrange)
            X = Application.WorksheetFunction.Min(lkrange)
            Z = Application.WorksheetFunction.CountIf(lkrange, X)
            
            .AutoFilterMode = False
            r1.AutoFilter
            r1.AutoFilter field:=j, Criteria1:=m
            lastrow = Cells(.Rows.Count, j).End(xlUp).Row
            If lastrow > 1 Then
                Set rFoundCell = Range(Cells(3, j), Cells(lastrow, j)).SpecialCells(xlCellTypeVisible)
                
                If rFrmtTheseCells Is Nothing Then
                    Set rFrmtTheseCells = rFoundCell
                Else
                    Set rFrmtTheseCells = Union(rFrmtTheseCells, rFoundCell)
                End If
            End If
            
            ActiveSheet.AutoFilterMode = False
            
            If X > 0 Then Y = Application.WorksheetFunction.Match(X, lkrange, 0)
            
            If Z = 1 Then
                If rFrmtTheseCellsToo Is Nothing Then
                    Set rFrmtTheseCellsToo = .Cells(Y + 2, j)
                Else
                    Set rFrmtTheseCellsToo = Union(rFrmtTheseCellsToo, .Cells(Y + 2, j))
                End If
            End If
            
        Next j
        
        ' Format the LOWEST value cells that were found above, all at one time.
        With rFrmtTheseCells.Cells
            .Font.Color = vbRed
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
              
        ' Format the Single count MIN cells that were found above, all at one time.
        With rFrmtTheseCellsToo
            .Font.Italic = True
            .Font.Bold = True
            .Font.Size = 12
            .Interior.Color = 255
            .Font.ThemeColor = xlThemeColorDark1
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
        
        .Range(Cells(3, 11), Cells(lr, 11)).ClearFormats
        .Range(Cells(3, 21), Cells(lr, 21)).ClearFormats
        
        .Range(Cells(3, 2), Cells(lr, 26)).HorizontalAlignment = xlCenter
        .Range(Cells(3, 2), Cells(lr, 26)).VerticalAlignment = xlCenter
        
        If .Range("B3").Value >= "*" Then
          .Range("B3:Z40").SpecialCells(xlCellTypeConstants).Borders.ColorIndex = 1
        End If
        
        '''''''
        '  Code formats the entire sheet's Font=Red when only ("A3:Z50") should be Red Font, so...workaround,
        .Range("A1:Z2").Font.Color = vbBlack
        .Range("V1:BH50").Font.Color = vbBlack
        '''''''
        .Range("W3:Z40").Font.Size = 4
        
        'These two statements placed here inside the 'With.....End With' for the ws object instead of explicitly referenceing them as they were about 9 lines down below outside the WITH.
        .Select
        .Range("A1").Select
        
    End With ' matches the 'With ws' just above the ".Columns("A").AutoFit" line of code.
    
    Set rFrmtTheseCells = Nothing
    Set rFrmtTheseCellsToo = Nothing
    Set lkrange = Nothing
    
    ' moved these next two lines inside the 'End With' for the ws. not a biggie but we are working with the 'ws' object so we might as well do the actions there.
    'ws.Select
    'ws.Range("A1").Select
    
    Set ws = Nothing
    
  End Sub

Creepy-crawly code on my tablets

Big Lar

Well-known Member

Excel Facts

ImranMalek

Board Regular

brucef2112

Board Regular

Big Lar

Well-known Member

Big Lar

Well-known Member

brucef2112

Board Regular

brucef2112

Board Regular

Similar threads

Forum statistics

Share this page

Creepy-crawly code on my tablets

Big Lar

Well-known Member

Excel Facts

ImranMalek

Board Regular

brucef2112

Board Regular

Big Lar

Well-known Member

Big Lar

Well-known Member

brucef2112

Board Regular

brucef2112

Board Regular

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock