Function IntToLet(number As Integer) As String
    IntToLet = Switch(number = 1, "A", number = 2, "B", number = 3, "C", number = 4, "D", number = 5, "E", number = 6, "F", number = 7, "G", number = 8, "H")
    Exit Function
End Function
Function neighbour(X As Integer, Y As Integer) As Integer
    Dim tmpX As Integer
    Dim tmpY As Integer
    
    Dim counter As Integer
    counter = 0
    If X > 1 And ActiveSheet.Range(IntToLet(X - 1) & Y).Value <> "" Then counter = counter + 1
    If X < 8 And ActiveSheet.Range(IntToLet(X + 1) & Y).Value <> "" Then counter = counter + 1
    If Y < 8 And ActiveSheet.Range(IntToLet(X) & Y + 1).Value <> "" Then counter = counter + 1
    If Y > 1 And ActiveSheet.Range(IntToLet(X) & Y - 1).Value <> "" Then counter = counter + 1
    If X > 1 And Y > 1 And ActiveSheet.Range(IntToLet(X - 1) & Y - 1).Value <> "" Then counter = counter + 1
    If X < 8 And Y < 8 And ActiveSheet.Range(IntToLet(X + 1) & Y + 1).Value <> "" Then counter = counter + 1
    If X > 1 And Y < 8 And ActiveSheet.Range(IntToLet(X - 1) & Y + 1).Value <> "" Then counter = counter + 1
    If X < 8 And Y > 1 And ActiveSheet.Range(IntToLet(X + 1) & Y - 1).Value <> "" Then counter = counter + 1
    neighbour = counter
    Exit Function
End Function
Sub FillBlankCells()
   
Dim Letter As String
Dim I As Integer
Dim J As Integer

For J = 2 To 7
    For I = 2 To 7
    Letter = IntToLet(I)
    Dim cnt As Integer
    cnt = neighbour(I, J)
    If cnt < 2 Then ActiveSheet.Range(Letter & J).Value = ""
    If cnt = 3 Then ActiveSheet.Range(Letter & J).Value = ActiveSheet.Range(Letter & J).Value + 1
    If cnt > 3 Then ActiveSheet.Range(Letter & J).Value = ""
    
    Next I
Next J
    
End Sub