Test blank cell and out put phonetic (text)

Question

I have this code which first checks for blank cell in Column B, and then blank cells in Column F. If the results is Yes-No, then it prints the phonetic into F.

Can someone review the code, please? I am also wondering if there is a way to set the starting point to be Column B (therefore, Cells(i,1)=B1) and possibility replace Cells(i,2) by dim as something(long?).

Sub test()

'Dim rng As Range
Dim i As Long

'Set rng = Range("B:B")
i = 1

Do Until IsEmpty(Cells(i, 2))

    If Cells(i, 2).Value <> "" Then
        If Cells(i, 6).Value = "" Then
        Cells(i, 2).Offset(0, 4).Value = Cells(i, 2).Phonetic.Text
        End If
    End If
    i = i + 1
Loop

End Sub

Answer 1

Give your code a good name - not test - it doesn't tell me what it's doing.

At the same time, it's implicitly public so you might as well put that and always turn on Option Explicit. You can have it automatically by going to Tools -> Options in the VBE and checking the Require Variable Declaration option. This way if you have any variables not defined, the compiler will let you know.

You can use Do Until isEmpty but why not find the last cell and use a For loop? There is a standard way to find lastRow and lastColumn. That post explains why.

Technically you could eliminate If Cells(i, 2) <> vbNullString because the lastRow should determine that, but so would your Do Until isEmpty so it's already repetitive. You can also avoid assigning i an initial value and get rid of your messy (for VBA) iteration.

I would also eliminate the if block, personally.

Option Explicit

Public Sub GetPhonetic()
    Dim lastRow As Long
    lastRow = Cells(Rows.Count, 2).End(xlUp).Row
    Dim i As Long
    For i = 1 To lastRow
        If Cells(i, 6) <> vbNullString Then Cells(i, 6) = Cells(i, 2).Phonetic.Text
    Next i
End Sub

Also eliminate the commented code - if you aren't using it, it's just noise. I also eliminated the extra white space as you don't need it.

---

Re:

I am also wondering if there is a way to set the starting point to be Column B (therefore, Cells(i,1)=B1) and possibility replace Cells(i,2) by dim as something(long?)?

I'm not sure what you mean here, you are already dim i as long and using that to determine your starting point; there's no need for it to be more complicated than cells(i,y).

Answer 2

I think that SpecialCells() method would be very handy here to keep things very simple (no loops) and short (1 line)

Sub main()
    Range("B:B").SpecialCells(xlCellTypeConstants, xlTextValues).Offset(, 4).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=PHONETIC(RC2)"
End Sub

where:

    Range("B:B").SpecialCells(xlCellTypeConstants, xlTextValues)

will filter column "B" non blank cells and reference them

    .Offset(, 4)

will shift referenced cells 4 columns to the left of referenced one

    .SpecialCells(xlCellTypeBlanks)

will filter these latter referenced cells blank ones

    .FormulaR1C1

will call the formula property of the referenced cells range to write in

    = "=PHONETIC(RC2)"

will write in referenced cells a formula that calls PHONETIC() method that extracts the phonetic (furigana) characters from corresponding column "B" cells content, since RC2 stands for "current row column 2"

I must add that that single-line code assumes that there actually is at least one non blank cell in column "B" and at least one corresponding blank cell in column "F"

so that a minimal, but effective, handling of both assumptions failure could be

Sub main()
    On Error Resume Next
    Range("B:B").SpecialCells(xlCellTypeConstants, xlTextValues).Offset(, 4).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=PHONETIC(RC2)"
End Sub