Speeding up execution time of worksheet-formatting code

I've been writing some code that places some data in an empty worksheet and then formats the sheet by adding borders to all of the used cells. The code functions how it should perfect, but it takes a little bit of time to execute. I was wondering if there is any way I can speed up my code that I'm missing, because I don't know if there is a more efficient way to do what I've done.

Sub Report()

Application.ScreenUpdating = False
Sheets("Raw Data").Select
Application.Calculation = xlCalculationManual

Sheets("Raw Data").Unprotect

    Req = UniqueRequest()
    SheetForm = ReqSheetFormat()
    ReqColor = ReqColorCount()

Sheets("Raw Data").Protect

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

Function ColSearch(Heading As String) As Integer
'Determines the column number of the desired heading

Sheets("Raw Data").Select
Sheets("Raw Data").Unprotect

    Dim myCol As Integer

    'Determines column number for desired string
    myCol = Sheets("Raw Data").Cells.Find(What:=Heading, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False).Column

ColSearch = myCol

End Function

```
Function UniqueRequest() As Long
'Creates dictionary full of unique request ID's and lists them in the "Request Results" sheet

Dim d As Object, tmp2
Dim LastRow As Long
Dim LastColumn As Long
Dim i As Long
Dim n As Long
Dim x As Long
Dim cllsct As Long
Dim myReqIDCol As Integer
Dim myNameCol As Integer
Dim myTypeCol As Integer
Dim myDescCol As Integer
Dim myVerCol As Integer
Dim myTstCol As Integer

'Determines the last row and the last column of the table
LastRow = Range("A" & Rows.count).End(xlUp).row
LastColumn = Cells(1, Columns.count).End(xlToLeft).Column

'Determines desired column number and stores it to a variable
myReqIDCol = ColSearch("id")
myNameCol = ColSearch("ownerFullname")
myTypeCol

I only reviewed the first sub routine posted. I might get to the others at a later time.

Don't use PascalCase for variables, that should be for function, subs and classes. Single letter variables should be avoided. Also this is a personal preference but I like to put variable declarations right before to the initialization, especially with iterators for loops.

Dim i As Long
Dim j As Long
Dim LastRow As Long
Dim LastColumn As Long

You request this sheet often.

Sheets("Request Results")

I recommend declaring a WorkSheet variables and setting it to this sheet. Also consider declaring a Constant for the name of the sheet. If you use use this sheet with other macros consider making separate function just to access the sheet.

Const REQUEST_SHEET_NAME As String = "Request Results"
Const REQUEST_BOOK_NAME As String = "your workbook's name"

Function GetRequestSheet() As WorkSheet

    Set GetRequestSheet = Workbooks(REQUEST_BOOK_NAME).Sheets(REQUEST_SHEET_NAME)

End Function

' In Sub
Dim requestSheet as Worksheet
Set requestSheet = GetRequestSheet()

This should be done for any other sheets.

You create your header statically, first I recommend setting a header variable as you access it more than once.

Dim headerRange as Range
Set headerRange = Range(requestSheet.Cells(1, 1), requestSheet.Cells(1, LastColumn))

Second, you should declare each field header as a constant and each column index as a constant.
Consider linking them in a function that returns a "Scripting.Dictionary" Object structured so that {column_index -> field_name}.

Function GetHeaderDict() As Object

    Set GetHeaderDict = CreateObject("Scripting.Dictionary")
    GetHeaderDict.Add REQUEST_ID_COL, REQUEST_ID_HEADER
    ' ...
End Function

Printing the header to the sheet should be a separate Sub routine.

lastColumn = requestSheet.Cells(1, Columns.count).End(xlToLeft).Column
lastRow = requestSheet.Range("A" & Rows.count).End(xlUp).row

Also I don't know why people keep using the End method to count used rows and columns. I've used sheet.UsedRange.Rows.Count and sheet.UsedRange.Rows.Count. It considers data in all rows and columns not just the first. And I suspect it's faster, though I haven't tested it.

EDIT

See the ckuhn203's linked question about finding the last column and row. If your request sheets are guaranteed to be rectangular then your current method should be acceptable with prefixing Column.Count and Row.Count with your sheet.

lastColumn = requestSheet.Cells(1, requestSheet.Columns.count).End(xlToLeft).Column
lastRow = requestSheet.Range("A" & requestSheet.Rows.count).End(xlUp).row

You could also use UsedRange if you are confident that "A1" is filled and you want to include cells that are used in any way.

Otherwise, use the linked solution. Put it into a separate function and keep it in a separate module for future use.

The redundancies in the next loop are staggering.

• Declaring that requestSheet Object will reduce clutter and prevent redundant access of WorkSheets just to find the same sheet over and over again.

• Consider entering line breaks with the _ token to make this conditional more readable. This is a preference of mine. Others don't like to use _ as much as I do.

• Declare constants for your colors and column Indexes, it makes the code easier to maintain and let's readers know why the cell/color is significant.

• maybe even declare a range object and set the cells to it

Making some those suggestions turns this to

Dim some_cell as Range
Set some_cell = requestSheet.Cells(i, SOME_COL)

Dim other_cell as Range
Set other_cell = requestSheet.Cells(i, OTHER_COL)

If some_cell.Value = "Yes" _
And other_cell.Value = "No" _
And other_cell.Interior.Color <> COLOR_BAD Then

    other_cell.Interior.Color = COLOR_RED

ElseIf other_cell.Value = "Yes" Then

    other_cell.Interior.Color = COLOR_MARK

ElseIf other_cell.Value = "No" _
And other_cell.Interior.Color <> COLOR_BAD Then

    other_cell.Interior.Color = COLOR_MARK

End If

There are 4 with statements like this that have nothing to do with i and don't need to be looped over.

With Sheets("Request Results").Range(Cells(1, 1), Cells(1, LastColumn))
    .Borders(xlEdgeBottom).Color = 0
    .Borders(xlEdgeBottom).Weight = xlThick
End With

You could just move them out of the loop, but I would recommend also moving it to another function.

Sub GiveRangeBoldBorder(rng as Range)

    Dim edge As Variant
    For Each edge in Array(xlEdgeBottom, xlEdgeTop, xlEdgeLeft, xlEdgeRight)

        With rng.Borders(edge)

            .Color = 0
            .Weight = xlThick

        End With

    Next edge

End Sub

You also don't need to loop to add any borders. This will give thin borders to all cells in your used range.

With requestSheet.UsedRange.Borders

    .Color = 0
    .Weight = xlThin

End With

So now your formatting is just

```
' Give al

StackExchange Code Review Q#59717, answer score: 8