Syntax error in dynamic SQL string

Please help to fix the following syntax error with Like statement. The query works with = but I need to use Like to search in the AAchange field. I think the problem is here "WHERE [AAchange] LIKE '" & "%" & _ but I'm not sure how to correct this syntax. Please see the code below:

Sub ColorNewVariant()

Dim PolicyNum As Variant
Dim bFound As Boolean

Dim cnn As ADODB.Connection 'dim the ADO collection class
Dim rs As ADODB.Recordset 'dim the ADO recordset class
Dim dbPath As String
Dim strSQL As String
Dim r As Range, cell As Range
Dim LastRow As Long

LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

Application.EnableEvents = False

Set r = ThisWorkbook.ActiveSheet.Range("G3:G" & LastRow)
For Each cell In r
        If cell.Value <> "" Then

            PolicyNum = cell.Value

            dbPath = PATH_MAIN & "\Report\MDL_IonTorrent.accdb"

            Set cnn = New ADODB.Connection ' Initialise the collection class variable

            'Connection class is equipped with a -method- Named Open
            '--4 aguments-- ConnectionString, UserID, Password, Options
            'ConnectionString formula--Key1=Value1;Key2=Value2;Key_n=Value_n;
            cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath

            strSQL = "SELECT [AAchange] " & _
            "FROM [MDL_Table1] " & _
            "WHERE [AAchange] LIKE '" & "%" & _
            Replace(PolicyNum, """", """""", , , vbTextCompare) & _
            """"

            'Create the ADODB recordset object.
            Set rs = New ADODB.Recordset 'assign memory to the recordset

            'ConnectionString Open '--5 aguments--
            'Source, ActiveConnection, CursorType, LockType, Options
            rs.Open strSQL, cnn

            bFound = Not rs.EOF

            'Check if the recordset is empty.

            'Close the recordet and the connection.
            rs.Close
            cnn.Close
            'clear memory
            Set rs = Nothing
            Set cnn = Nothing
            'Enable the screen.

            If bFound Then
            'MsgBox "Record exists."

            Else
            'MsgBox "Record not found."
            'cell.Interior.ColorIndex = 8
            cell.Interior.Color = RGB(255, 217, 218)
            'cell.ClearComments
            'cell.AddComment "New Variant"
    'Fits shape around text
            'cell.Comment.Shape.TextFrame.AutoSize = True
            End If

End If
    Next cell

Application.EnableEvents = True

End Sub