VBA – Resolving C# competition problem with VBA and Excel

Today I have decided to resolve one of the competition problem of the C# basics exam of the SoftUni (www.softuni.bg) with Excel. I have shown how I have resolved a similar problem in C#, where you should have drawn a glass of wine here. The problem is about building a string, which consists of dots and stars, in a way that it looks like a plane, if you have more phantasy:

For the really curious, I have a pdf version of the exam problem 03.Plane it is licensed under the CC-BY-NC-SA license, so take it in mind, if you redistribute it.

Pretty much what I wanted to achieve is something like this – I wanted to write a custom formula in Excel, with one parameter  and to get the output as expected in the example. Did I manage to do it? Check it by yourself:

The question is more or less how I did it. The answer is – following the C# logic and accustoming VBA to my C# knowledge. As far as I did not have a string builder in VBA, I have created a similar function, called fStringBuilder(), taking two arguments – the string which is going to be repeated and the times of repetition. At the end, I have saved everything in the fPlane function, using VbCrLf for spaces. And the i=0 on each line was needed, because this is the way to code in VBA – the for loop is a little … different :). Last but not least, the result should be displayed in a font such as Courier, because it gives each char an equal space. Or simply print it in the immediate window with debug.Print.

Anyway, it is easier to be seen than explained.

At the end I wanted to make it a little bit more fancier, so I have created the sub colorMe(). It colors all the stars Chr(42) into Red. Quite a good one and rather slow actually, but if you look at the code you will realize the reason for the slowness – after all we are printing and this is a scripting language:

Finally, here comes the code – just copy it in a module and use the new fancy function in Excel:

Option Explicit
Public Function fPlane(n As Integer) As String

    Dim iWidth As Integer
    Dim iHeight As Integer
    Dim iCount As Integer
    Dim sStar As String
    Dim sDot As String
    Dim i As Integer
    Dim sResult As String

    sStar = "*"
    sDot = "."
    iWidth = 3 * n
    iHeight = ((n * 3) - (n / 2))
    iCount = 1
    i = 0
    fPlane = fStringBuilder((iWidth - 1) / 2, sDot) & sStar & fStringBuilder((iWidth - 1) / 2, sDot) & vbCrLf

    Do While (i < n)
        If i <= (n / 2 + 1) Then
            fPlane = fPlane & fStringBuilder((iWidth - 1 - 2 * i) / 2 - 1, sDot) & _
                     sStar & _
                     fStringBuilder(1 + 2 * i, sDot) & _
                     sStar & _
                     fStringBuilder((iWidth - 1 - 2 * i) / 2 - 1, sDot) & _
                     vbCrLf
        Else

            fPlane = fPlane & fStringBuilder((iWidth - 1 - 2 * i) / 2 - 1 - iCount, sDot) & _
                     sStar & _
                     fStringBuilder(1 + 2 * i + 2 * iCount, sDot) & _
                     sStar & _
                     fStringBuilder((iWidth - 1 - 2 * i) / 2 - 1 - iCount, sDot) & _
                     vbCrLf

            iCount = iCount + 1
        End If
        i = i + 1
    Loop

    fPlane = fPlane & sStar & _
             fStringBuilder(n - 2, sDot) & _
             sStar & _
             fStringBuilder(n, sDot) & _
             sStar & _
             fStringBuilder(n - 2, sDot) & _
             sStar & _
             vbCrLf

    i = 1

    Do While (i <= (n / 2) - 1)
        fPlane = fPlane & sStar & _
                 fStringBuilder(n - 2 - 2 * i, sDot) & _
                 sStar & _
                 fStringBuilder(2 * i - 1, sDot) & _
                 sStar & _
                 fStringBuilder(n, sDot) & _
                 sStar & _
                 fStringBuilder(2 * i - 1, sDot) & _
                 sStar & _
                 fStringBuilder(n - 2 - 2 * i, sDot) & _
                 sStar & _
                 vbCrLf
        i = i + 1
    Loop

    i = 0

    Do While (i < n - 1)
        fPlane = fPlane & fStringBuilder(n - 1 - i, sDot) & _
                 sStar & _
                 fStringBuilder(n + 2 * i, sDot) & _
                 sStar & _
                 fStringBuilder(n - 1 - i, sDot) & _
                 vbCrLf
        i = i + 1
    Loop

    fPlane = fPlane & fStringBuilder(iWidth, sStar) & vbCrLf & "www.vitoshacademy.com"

End Function

Public Function fStringBuilder(ByVal iTimes As Integer, ByVal sAdded As String) As String

    fStringBuilder = ""
    Dim zCounter As Integer

    For zCounter = 1 To iTimes
        fStringBuilder = fStringBuilder & sAdded
    Next

End Function

Sub colorMe()

    Dim i As Integer
    Dim sSearchString As String
    Dim FindChar As String

    activecell.Value = CStr(activecell.Value)
    sSearchString = activecell.Value
    FindChar = Chr(42)

    For i = 1 To Len(sSearchString)
        If Mid(sSearchString, i, 1) = FindChar Then
            activecell.Characters(i, 1).Font.Color = RGB(255, 0, 0)
        End If
        activecell.Characters(i, 1).Font.Bold = True
    Next i

    activecell.HorizontalAlignment = xlCenter

End Sub

🙂