1

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

Improve this question

3 Answers 3

Reset to default
2

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
Improve this answer
Sign up to request clarification or add additional context in comments.

10 Comments

That's the thing, I don't want for it to be kept in a separate column, I would rather it just change the data currently IN the cell. Could i just call this function on the range of the cells through a Sub?
Sure: For Each rng in Range("A1:A100").Cells: rng.Value = ConvertIt(rng): Next
Now I'm getting some weird error " Compile Error ByRef argument type mismatch" and it then hightlights the declaration for my Sub routine. I hate VBScript.
I just tested it, works fine. See my above edit - did you declare anything differently?
Awesome! and in order to do so on multiple columns I would just repeat the process, renaming the range? (I know it seems stupid but I've been working with this for 8 hours and can't make heads or tails of what is going on)
|
1

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
Improve this answer

Comments

1

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
Improve this answer

1 Comment

The weird quotes was because I typed this up in Word before posting it here.

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.