Macro double underline range if col q = *

Question

I have a question that I cant solve. The problem lies in col Q. What I want is simple:

Scan col Q from row 5 until last row (last row value is in cell "AL1") If there is a "*" (symbol is stored in cell "AK2") in that row of Q. Then double underline cells A thru AF in that row, continue scanning down until last row.

    Sub Reformat()

    Dim SrchRng3 As Range
    Dim c3 As Range, f As String

   Set SrchRng3 = ActiveSheet.Range("Q5",          ActiveSheet.Range("Q100000").End(xlUp))
Set c3 = SrchRng3.Find(Range("ak2"), LookIn:=xlValues)
If Not c3 Is Nothing Then
    f = c3.Address
    Do
        With ActiveSheet.Range("A" & c3.Row & ":AF" & c3.Row)
        Range("A" & c3.Row & ":AF" & c3.Row).Select
                .Borders (xlEdgeBottom)
                .LineStyle = xlDouble
                .ThemeColor = 4
                .TintAndShade = 0.399945066682943
                .Weight = xlThick
        End With
        Set c3 = SrchRng3.FindNext(c3)
    Loop While c3.Address <> f
End If
End Sub

Answer 1

Is this what you are trying? I have commented the code so you shouldn't have a problem understanding it. If you still do or you get an error, simply let me know :)

Sub Reformat()
    Dim rng As Range
    Dim aCell As Range, bCell As Range
    Dim ws As Worksheet
    Dim lRow As Long

    '~~> Change as applicable. Do not use Activesheet.
    '~~> The Activesheet may not be the sheet you think
    '~~> is active when the macro runs
    Set ws = ThisWorkbook.Sheets("Sheet1")

    With ws
        '~~> Find last row in Col Q
        lRow = .Range("Q" & .Rows.Count).End(xlUp).Row

        '~~> Set your Find Range
        Set rng = .Range("Q5:Q" & lRow)

        '~~> Find (When searching for "*" after add "~" before it.
        Set aCell = rng.Find(What:="~" & .Range("AK2"), LookIn:=xlFormulas, _
                    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False)

        If Not aCell Is Nothing Then
            Set bCell = aCell

            '~~> Create the necessary border that you are creating
            With .Range("A" & aCell.Row & ":AF" & aCell.Row).Borders(xlEdgeBottom)
                .LineStyle = xlDouble
                .ThemeColor = 4
                .TintAndShade = 0.399945066682943
                .Weight = xlThick
            End With

            Do
                Set aCell = rng.FindNext(After:=aCell)

                If Not aCell Is Nothing Then
                    If aCell.Address = bCell.Address Then Exit Do

                    '~~> Create the necessary border that you are creating
                    With .Range("A" & aCell.Row & ":AF" & aCell.Row).Borders(xlEdgeBottom)
                        .LineStyle = xlDouble
                        .ThemeColor = 4
                        .TintAndShade = 0.399945066682943
                        .Weight = xlThick
                    End With
                Else
                   Exit Do
                End If
            Loop
        End If
    End With
End Sub

Screenshot