Search code examples
vbaexcelencodingcharacter-encoding

VBA selective conversion of double-byte to single-bye characters


I've written my first VBA sub, and it's KIND OF working the way it's supposed to, but I cannot figure out the part that's wrong. It's supposed to selectively convert double-byte spaces, letters, numbers, and punctuation to single-byte when there is a string of double-byte Japanese and Latinate characters and spaces.

In this picture, the top row represents the input and the bottom row the desired output of spaces, letters, numbers, and punctuation converted to single-byte while the Japanese characters remain intact.

However, this is what is happening when I run the sub. Clearly it's working, but also something is off with my concatenation.

The code is below and works based on "catching and converting" the range of UTF-16 codes that correspond to the problematic full-width characters. It only functions on localized machines (i.e. when language/region is set to Japan) but I don't think the issue with my code has to do with localized functions. Any help on what I'm doing wrong would be greatly, greatly appreciated!

Public Sub Converter()
    Dim objRange As Range
        For Each objRange In ActiveSheet.UsedRange
        Call Alphanumeric(objRange)
    Next
End Sub

Private Sub Alphanumeric(ByRef objRange As Range)
    Dim strIn As String
    Dim strOut As String
    Dim strAlphanumeric As String
    Dim i As Integer

    If objRange.HasFormula Or _
        VarType(objRange.Value) <> vbString Then
        Exit Sub
    End If

    strIn = objRange.Value
    strOut = ""
    strAlphanumeric = ""

    For i = 1 To Len(strIn)
        If AscW(Mid(strIn, i, 2)) + 65536 >= 65280 And _
           AscW(Mid(strIn, i, 2)) + 65536 <= 65370 Then
           strAlphanumeric = strAlphanumeric & Mid(strIn, i, 1)
        Else
            If strAlphanumeric <> "" Then
                strOut = strOut & StrConv(strIn, vbNarrow)
                strAlphanumeric = ""
            End If
            strOut = strOut & Mid(strIn, i, 1)
        End If
    Next

    objRange.Value = strOut

End Sub

Solution

  • I suspect the line

    strOut = strOut & StrConv(strIn, vbNarrow)

    Should be to my eyes

    strOut = strOut & StrConv(strAlphanumeric, vbNarrow)