View Single Post
 
Old 09-07-2014, 09:19 PM
excelledsoftware excelledsoftware is offline Windows 7 64bit Office 2003
IT Specialist
 
Join Date: Jan 2012
Location: Utah
Posts: 455
excelledsoftware will become famous soon enough
Default

Alright sounds good.

A concern that you had was to make sure that your formula would know when to stop. VBA is really good at this because you can tell it to do something many times and tell it exactly when to stop. Learning VBA has been one of the best things that I have learned so if you are interested in what is going on with the code let me know and I will be happy to explain it to you.

The code below will REPLACE the values in column T with the specified format. Remember to backup your workbook before running it since this will change the existing data in column T on the first sheet of your workbook.

Code:
Option Explicit

Sub FormatNumberString()
  'Looks through a list of numbers on the first worksheet and formats them
  'with leading zeroes.
  
  Dim CheckRow As Long, LastRow As Long, CheckString() As String
  Dim x As Integer, arr As Long, ArrayString As Variant
  Dim NewString As String, TempString As String
  Dim wb As Workbook, ws As Worksheet
  
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets(1)
    LastRow = ws.Range("T50000").End(xlUp).Row
    ReDim CheckString(0 To LastRow - 1)
    
    'Grab the values
    arr = 0
    For CheckRow = 2 To LastRow
      CheckString(arr) = ws.Range("T" & CheckRow).Value
      arr = arr + 1
    Next CheckRow
    
    'Insert values back in with new format
    arr = 0
    For CheckRow = 2 To LastRow
      If CheckString(arr) <> "" Then
        'Convert each number to have leading zeroes
        ArrayString = Split(CheckString(arr), ",")
        For x = 0 To UBound(ArrayString)
          Select Case Len(ArrayString(x))
            Case 1:
              TempString = "00" & ArrayString(x)
            Case 2:
              TempString = "0" & ArrayString(x)
            End Select
            NewString = CStr(NewString & TempString & ",")
          Next x
          'Remove last comma
          NewString = Mid(NewString, 1, Len(NewString) - 1)
        ws.Range("T" & CheckRow).NumberFormat = "@"
        ws.Range("T" & CheckRow).Value = NewString
        NewString = ""
      End If
      arr = arr + 1
    Next CheckRow

End Sub
Let me know how it works out.

PS I know I said 8 lines of code I was really far off on that becuase I forgot it had both single, and double digit numbers to format. Sorry about that.

Thanks
Reply With Quote