Change straight quotes to curly quotes and vice versa

quotationreplace.vb

' Adapted to MSO 2016 with Windows-1251 solution from
' https://goo.gl/FwYgMp

Public Sub ToggleSmartQuotes()
    Dim rCell As Range
    Dim sText As String
    Dim sPattern1 As String
    Dim sPattern2 As String
    
    sPattern1 = "*[" & Chr(34) & Chr(39) & "]*"
    sPattern2 = "*[" & Chr(132) & Chr(148) & Chr(171) & Chr(187) & "]*"
    For Each rCell In Selection
        With rCell
            sText = .Text
            If sText Like sPattern1 Then
                .Value = SmartQuotes(sText, bSmart:=True)
            ' To replace vice versa
            'ElseIf sText Like sPattern2 Then
            '    .Value = SmartQuotes(sText, bSmart:=False)
            End If
        End With
    Next rCell
End Sub



Private Function SmartQuotes(ByVal sInput As String, _
        Optional ByVal bSmart As Boolean = True) As String
    Const csDumbDQ As String = """"
    Const csDumbSQ As String = "'"
    Const csSpace As String = " "
    Static sOpenSQ As String
    Static sCloseSQ As String
    Static sOpenDQ As String
    Static sCloseDQ As String
    Dim sTemp As String
    
    If sOpenSQ = vbNullString Then
        sOpenSQ = Chr(132)
        sCloseSQ = Chr(148)
        sOpenDQ = Chr(171)
        sCloseDQ = Chr(187)
    End If
    
    sTemp = sInput
    If bSmart Then
        sTemp = Replace(Replace(Replace(Replace(sTemp, _
                csSpace & csDumbSQ, csSpace & sOpenSQ), csSpace & csDumbDQ, _
                csSpace & sOpenDQ), csDumbSQ, sCloseSQ), csDumbDQ, sCloseDQ)
    Else
        sTemp = Replace(Replace(Replace(Replace(sTemp, sOpenSQ, csDumbSQ), _
                    sCloseSQ, csDumbSQ), sOpenDQ, csDumbDQ), sCloseDQ, csDumbDQ)
    End If
    SmartQuotes = sTemp
End Function