VBA code request to convert number variables

maddiefitz46 · Nov 12, 2014

If wondering if someone would be able to generate a macro to convert numbered data sets:

I have large amounts of data in the rough format x-x-x (where each x represents a different number).

I want to convert this data so that they are formatted to an 18 digit form: xx-xxxx-xxxx-xxxx-xxxx where the number value will remain the same, but the rest of the string is populated with zeroes.

Here are some examples:

4-13-3 should become 04-0013-0003-0000-0000

15-7-12 should become 15-0007-0012-0000-0000

Is this possible?

maddiefitz46 · Nov 14, 2014

Doesn't seem to be working Rick, I'm not sure why....when I try to run it, no results populate in any cell

Rick Rothstein · Nov 14, 2014

maddiefitz46 said:
Doesn't seem to be working Rick, I'm not sure why....when I try to run it, no results populate in any cell

Whoops! Sorry, I posted my test code (look at the VB editor's Immediate Window after running it) instead of the final code that you are supposed to use. This is the correct macro for you to use...

Code:

Sub Reformat()
  Dim X As Long, Cell As Range, Result As String, S() As String
  For Each Cell In Range("A1", Cells(Rows.Count, "A").End(xlUp))
    S = Split(Replace(Cell & "-0-0-0-0", ".", "-"), "-")
    Result = ""
    For X = 0 To 4
      Result = Result & "-" & Format(S(X), "@@@@")
    Next
    Cell.Offset(, 1) = Mid(Replace(Result, " ", 0), 4)
  Next
End Sub

Rick Rothstein · Nov 14, 2014

Rick Rothstein said:
Whoops! Sorry, I posted my test code (look at the VB editor's Immediate Window after running it) instead of the final code that you are supposed to use. This is the correct macro for you to use...

Code:

Sub Reformat() Dim X As Long, Cell As Range, Result As String, S() As String For Each Cell In Range("A1", Cells(Rows.Count, "A").End(xlUp)) S = Split(Replace(Cell & "-0-0-0-0", ".", "-"), "-") Result = "" For X = 0 To 4 Result = Result & "-" & Format(S(X), "@@@@") Next Cell.Offset(, 1) = Mid(Replace(Result, " ", 0), 4) Next End Sub

I just noticed that you said you have a large amount of data. While I know "large" is quite a subjective term, if you actually mean "huge" or "enormous", then this modified version of the above macro will execute quicker...

Code:

Sub Reformat()
  Dim R As Long, X As Long, Cell As Range, Data As Variant, Result As String, S() As String
  Data = Range("A1", Cells(Rows.Count, "A").End(xlUp))
  For R = 1 To UBound(Data)
    S = Split(Replace(Data(R, 1) & "-0-0-0-0", ".", "-"), "-")
    Result = ""
    For X = 0 To 4
      Result = Result & "-" & Format(S(X), "@@@@")
    Next
    Data(R, 1) = Mid(Replace(Result, " ", 0), 4)
  Next
  Range("B1").Resize(UBound(Data)) = Data
End Sub

shg · Nov 14, 2014

Or you could use a user-defined function:

Code:

[size=1][Table="width:, class:grid"][tr][td]Row\Col[/td][td][CENTER]A[/CENTER][/td][td][CENTER]B[/CENTER][/td][td][CENTER]C[/CENTER][/td][/tr]
[tr][td][CENTER]1[/CENTER][/td][td]6-12-2[/td][td]06-0012-0002-0000-0000[/td][td]B1: =Reformat(A1)[/td][/tr]

[tr][td][CENTER]2[/CENTER][/td][td]13-2-40[/td][td]13-0002-0040-0000-0000[/td][td][/td][/tr]

[tr][td][CENTER]3[/CENTER][/td][td]1-3B-2[/td][td]01-003B-0002-0000-0000[/td][td][/td][/tr]

[tr][td][CENTER]4[/CENTER][/td][td]10-2-3.2[/td][td]10-0002-0003-0002-0000[/td][td][/td][/tr]

[tr][td][CENTER]5[/CENTER][/td][td]4-6A-5.7[/td][td]04-006A-0005-0007-0000[/td][td][/td][/tr]

[tr][td][CENTER]6[/CENTER][/td][td]12-23-4.2[/td][td]12-0023-0004-0002-0000[/td][td][/td][/tr]

[tr][td][CENTER]7[/CENTER][/td][td]4-9-2.12[/td][td]04-0009-0002-0012-0000[/td][td][/td][/tr]

[tr][td][CENTER]8[/CENTER][/td][td]17-5C-22.4[/td][td]17-005C-0022-0004-0000[/td][td][/td][/tr]

[tr][td][CENTER]9[/CENTER][/td][td]5-3-4[/td][td]05-0003-0004-0000-0000[/td][td][/td][/tr]

[tr][td][CENTER]10[/CENTER][/td][td]1-2-3.4[/td][td]01-0002-0003-0004-0000[/td][td][/td][/tr]

[tr][td][CENTER]11[/CENTER][/td][td]15-12-23.10[/td][td]15-0012-0023-0010-0000[/td][td][/td][/tr]
[/table][/size]

Code:

Function Reformat(ByVal sInp As String) As String
    Dim asInp()     As String
    Dim i           As Long

    asInp = Split(Replace(sInp, ".", "-"), "-")
    ReDim Preserve asInp(0 To 4)

    For i = 0 To 4
        asInp(i) = Right("0000" & asInp(i), 4)
    Next i

    Reformat = Mid(Join(asInp, "-"), 3)
End Function

maddiefitz46 · Nov 14, 2014

Thank you, it works perfectly

Would anyone be able to write one that takes the long form to the short form?

Examples:

01-0002-0004-0004-0000 --> 1-2-4.4
15-006A-0007-0000-0000 --> 15-6A-7

Thank you so much!!!! This is going to make me very popular at work

Rick Rothstein · Nov 14, 2014

If a UDF is, as 'shg' has proposed, what you want, then here is what my macro would look like when recast into one...

Code:

Function Reformat(S As String) As String
  Dim x As Long, Txt() As String
  Txt = Split(Replace(S & "-0-0-0-0", ".", "-"), "-")
  For x = 0 To 4
    Reformat = Reformat & "-" & Format(Txt(x), "@@@@")
  Next
  Reformat = Mid(Replace(Reformat, " ", 0), 4)
End Function

Rick Rothstein · Nov 14, 2014

maddiefitz46 said:
Thank you, it works perfectly Would anyone be able to write one that takes the long form to the short form?

Examples:

01-0002-0004-0004-0000 --> 1-2-4.4
15-006A-0007-0000-0000 --> 15-6A-7

Thank you so much!!!! This is going to make me very popular at work

What works perfectly for you... my macro or shg's UDF (we need to know so we know what to write)?

Rick Rothstein · Nov 14, 2014

Rick Rothstein said:
What works perfectly for you... my macro or shg's UDF (we need to know so we know what to write)?

Assuming you meant my macro, here is a macro to reverse it (looks in Column B for the data and writes the result to Column C)...

Code:

Sub UnReformat()
  Dim R As Long, X As Long, Data As Variant, Txt() As String
  Data = Range("B1", Cells(Rows.Count, "B").End(xlUp))
  For R = 1 To UBound(Data)
    Txt = Split(Replace(Data(R, 1), "-0000", ""), "-")
    For X = 0 To UBound(Txt)
      Txt(X) = Replace(LTrim(Replace(Txt(X), 0, " ")), " ", 0)
    Next
    Data(R, 1) = Join(Txt, "-")
    If UBound(Txt) = 3 Then Mid(Data(R, 1), InStrRev(Data(R, 1), "-")) = "."
  Next
  Range("C1").Resize(UBound(Data)).NumberFormat = "@"
  Range("C1").Resize(UBound(Data)) = Data
End Sub

maddiefitz46 · Nov 14, 2014

Rick - I'm getting a run time error saying "mismatch", do you know how to fix that?

hiker95 · Nov 14, 2014

maddiefitz46,

Is this enough examples?

Yes.

Sample raw data:

Excel 2007

A

B

1

6-12-2

2

13-2-40

3

1-3B-2

4

10-2-3.2

5

4-6A-5.7

6

12-23-4.2

7

4-9-2.12

8

17-5C-22.4

9

5-3-4

10

1-2-3.4

11

15-12-23.10

12

Sheet1

After the new macro:

Excel 2007

A

B

1

6-12-2

06-0012-0002-0000-0000

2

13-2-40

13-0002-0040-0000-0000

3

1-3B-2

01-3B00-0002-0000-0000

4

10-2-3.2

10-0002-0003-0002-0000

5

4-6A-5.7

04-6A00-0005-0007-0000

6

12-23-4.2

12-0023-0004-0002-0000

7

4-9-2.12

04-0009-0002-0012-0000

8

17-5C-22.4

17-5C00-0022-0004-0000

9

5-3-4

05-0003-0004-0000-0000

10

1-2-3.4

01-0002-0003-0004-0000

11

15-12-23.10

15-0012-0023-0010-0000

12

Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Code:

Sub ConvertTextNumbers_V2()
' hiker95, 11/14/2014, ME817799
Dim c As Range, s, i As Long
Dim s2, j As Long
Dim h As String, n As Long, d As Long
Application.ScreenUpdating = False
For Each c In Range("A1", Range("A" & Rows.Count).End(xlUp))
  s = Split(c, "-")
  h = "": d = 0
  If InStr(s(2), ".") Then
    For i = LBound(s) To UBound(s) - 1
      If IsNumeric(s(i)) Then
        If i = 0 Then
          h = h & Format(s(i), "00") & "-"
        Else
          h = h & Format(s(i), "0000") & "-"
        End If
      Else
        n = Len(s(i))
        If n = 1 Then
          h = h & s(i) & "000-"
        ElseIf n = 2 Then
          h = h & s(i) & "00-"
        ElseIf n = 3 Then
          h = h & s(i) & "0-"
        End If
      End If
    Next i
    s2 = Split(s(2), ".")
    h = h & Format(s2(0), "0000") & "-"
    h = h & Format(s2(1), "0000") & "-"
    h = h & "0000"
    c.Offset(, 1) = h
  Else
    For i = LBound(s) To UBound(s)
      If IsNumeric(s(i)) Then
        If i = 0 Then
          h = h & Format(s(i), "00") & "-"
          d = d + 1
        Else
          h = h & Format(s(i), "0000") & "-"
          d = d + 1
        End If
      Else
        n = Len(s(i))
        If n = 1 Then
          h = h & s(i) & "000-"
          d = d + 1
        ElseIf n = 2 Then
          h = h & s(i) & "00-"
          d = d + 1
        ElseIf n = 3 Then
          h = h & s(i) & "0-"
          d = d + 1
        End If
      End If
    Next i
    If d = 3 Then
      h = h & "0000-0000"
    ElseIf d = 4 Then
      h = h & "0000"
    End If
    c.Offset(, 1) = h
  End If
Next c
Columns(2).AutoFit
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ConvertTextNumbers_V2 macro.

VBA code request to convert number variables

maddiefitz46

New Member

maddiefitz46

New Member

Excel Facts

Rick Rothstein

MrExcel MVP

Rick Rothstein

MrExcel MVP

shg

MrExcel MVP

maddiefitz46

New Member

Rick Rothstein

MrExcel MVP

Rick Rothstein

MrExcel MVP

Rick Rothstein

MrExcel MVP

maddiefitz46

New Member

hiker95

Well-known Member

Similar threads

Forum statistics

Share this page

VBA code request to convert number variables

New Member

New Member

Excel Facts

MrExcel MVP

MrExcel MVP

MrExcel MVP

New Member

MrExcel MVP

MrExcel MVP

MrExcel MVP

New Member

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock