Sub hello()
    Dim row As Integer
    Dim col As Integer
    Dim CharPos As Integer
    Name = InputBox("Enter Some text")
    Dim NameLen As Integer
    NameLen = Len(Name) + 1
    For row = 1 To NameLen * 2
        For col = 1 To NameLen
            Cells(row, col).Value = ""
            Cells(row, col).Interior.Color = RGB(255, 255, 255)
        Next col
    Next row
    For row = 1 To NameLen * 2
        For col = 1 To NameLen - 1
            CharPos = (row - (NameLen * col)) + ((col - 1) * NameLen) + col
            If CharPos > 0 And CharPos < NameLen Then
                Cells(row, col).Value = Mid(Name, CharPos, 1)
                '                                             first color is black
                Cells(row, col).Interior.ColorIndex = CharPos + 1
            End If
        Next col
    Next row
End Sub