Excel Formatting with VBA

Question

Where I work we keep a list of vehicles that we find with damages. These damage codes come in a few variations, and I would like to setup a VBA script in excel to auto change the contents of a cell with the correct formatting, but I don't really use VBA scripting and the Excel data objects confuse me

Here are a few examples of what I would like

06071 – VBA Function – 06.07.1
031211 – VBA Function- 03.12.1(1)
0409237-VBA Function – 04.09.2(3,7)
040912 030713 –VBA Function – 04.09.1(2) 03.07.1(3) (some vehicles have multiple damages)

Basically any number past length 5 would put any numbers in the 6th position onward into the parentheses, separated by commas.

I could do this in just about any other language, it's just with all the random Excel stuff I am having issue after issue.

It doesn't seem to matter what I try, my code bugs out before I can make any progress past

Dim test
test = Worksheets(“Sheet1”).Range(“A:A”).Value
Worksheets(“Sheet2”).Range(“B:B”).Value=test

I tried to make a function which ended up not working no matter how I called it. If I could just basic formatting of these numbers, I could more than likely figure it out from there.

Thanks for any help you guys can give me

Answer 1

You can do this with a UDF (user defined function): Place the following code in a new module in VBA:

Function ConvertIt(rng As Range) As String
    Dim varStr As Variant
    Dim strSource As String, strResult As String
    Dim i As Integer

    For Each varStr In Split(Trim(rng.Value), " ")
        strSource = CStr(varStr)
        strResult = strResult & _
            Mid(strSource, 1, 2) & "." & _
            Mid(strSource, 3, 2) & "." & _
            Mid(strSource, 5, 1)
        If Len(strSource) > 5 Then
            strResult = strResult & "("
            For i = 6 To Len(strSource)
                strResult = strResult & Mid(strSource, i, 1) & ","
            Next i
            strResult = Left(strResult, Len(strResult) - 1) & ")"
        End If
        strResult = strResult & " "
    Next
    ConvertIt = Left(strResult, Len(strResult) - 1)
End Function

Assuming that your data is in column A of your worksheet, place this formula in B2: =ConvertIt(A2) and copy it down. Done!

If you want to convert the cells in one rush and replace the source, use this code:

Sub ConvertAll()
    Dim rng As Range
    For Each rng In Range("A1:A100")
        rng.Value = ConvertIt(rng)
    Next
End Sub

Answer 2

Lightly-tested:

Function FormatStuff(v)
Dim i As Long, c As String, v2 As String, num As String
Dim num2 As String, x As Long

    v2 = v
    v = v & " "
            For i = 1 To Len(v)
        c = Mid(v, i, 1)
        If c Like "#" Then
            num = num & c
        Else
            If num <> "" And Len(num) >= 5 Then
                num2 = Left(num, 2) & "." & Mid(num, 3, 2) & _
                       "." & Mid(num, 5,1)

                If Len(num) > 5 Then
                    num2 = num2 & "("
                    For x = 6 To Len(num)
                        num2 = num2 & IIf(x > 6, ",", "") & Mid(num, x, 1)
                    Next x
                    num2 = num2 & ")"
                End If

                v2 = Replace(v2, num, num2)
            End If
            num = ""
        End If
    Next i
    FormatStuff = v2
End Function

Answer 3

To answer your unasked question:

There are two reasons the code you supplied does not work.

1. Range("A:A") and Range("B:B") both select entire rows, but the test variable can only hold content for one cell value at a time. If you restrict your code to just one cell, using Range("A1").value , for example, the code you have written will work.
2. It seems you used different quotation marks than the standard, which confuses the compiler into thinking "Sheet1" , "A:A" . etc. are variables.

With the range defined as one cell, and the quotation marks replaced, your code moves the value of cell A1 on Sheet1 to cell B1 on Sheet2:

Sub testThis()

Dim Test
Test = Worksheets("Sheet1").Range("A1").value
Worksheets("Sheet2").Range("B1").value = Test

End Sub

If you wanted to work down the entire column A on Sheet1 and put those values into the column B on Sheet2 you could use a loop, which just repeats an action over a range of values. To do this I've defined two ranges. One to track the cells on Sheet1 column A, the other to track the cells on Sheet2 column B. I've assumed there is no break in your data in column A:

Sub testThat()

Dim CellinColumnA As Range
    Set CellinColumnA = Worksheets("Sheet1").Range("A1")

Dim CellinColumnB As Range
    Set CellinColumnB = Worksheets("Sheet2").Range("B1")

Do While CellinColumnA.value <> ""
    CellinColumnB.value = CellinColumnA.value
    Set CellinColumnA = CellinColumnA.Offset(1, 0)
    Set CellinColumnB = CellinColumnB.Offset(1, 0)
Loop

End Sub