Marco tha changes number format of text values

S

seattletimebandit

Board Regular
Joined
Apr 11, 2013
Messages
69
I have a spreadsheet with numbers as text values in cells:

0.5 U
0.500 U
6.06
141 J
... and so on.

I have an issue that some of the number formats have lost (or never had) trailing zeros. The value "0.5 U" should be "0.500 U". So I need to change the number format even though it's not really a number.

I could do a function to change the format, but I have differing formats. In another spreadsheet I had the following macro that could change the number format in a column based on the cell value in an adjacent cell ("U", or "D", or ""). But following code works with actual number values, not text values. Plus i have code that can make format changes to a range instead of having to run the code on specific cols/rows as the following code does.

Note that number formats:

<=1 are "0.000"
>= 1 and <= 9.9 are "0.00"
>= 10 and < 100 are "0.0"
>100 have no decimal point.

The table after the code is an example of formats already in table and those that need to be changed (mostly in Column G).


Code: 
Sub FormatTableColumns()

'***Loop On Rows and Columns***
'
'This will format Columns 8,10,12, etc. based on what is in 9,11,13, etc.
'
'Increment Columns by 2, Rows by 1
'
'NOTE: RUN THIS CODE AFTER AND TRANSPOSING FROM DATA CHECKING TABLE.  DO NOT RUN 'Sub FormatDataChecking TABLE UNTIL AFTER TRANSPOSING.
'
'
 For col = 8 To 136 Step 2
  For rw = 1 To 26
        
        If Cells(rw, col) <= 1 And Cells(rw, col + 1) = "U" Then _
            Cells(rw, col).NumberFormat = """< ""#,##0.00 "
     
        If Cells(rw, col) < 1 And Cells(rw, col + 1) = "U" Then _
            Cells(rw, col).NumberFormat = """< ""#,##0.00 "
        
        If Cells(rw, col) >= 10 And Cells(rw, col + 1) = "U" Then _
            Cells(rw, col).NumberFormat = """< ""#,### "
        
        If Cells(rw, col) >= 1 And Cells(rw, col) <= 9.9 And _
                Cells(rw, col + 1) = "U" Then _
                Cells(rw, col).NumberFormat = """< ""#,#0.0 "
          
        'Format numbers in Range of even columns that has an empty cell in Range of odd columns
        
        If Cells(rw, col) < 1 And Cells(rw, col + 1) = "" Then _
            Cells(rw, col).NumberFormat = "#,##0.00 "
        
        If Cells(rw, col) >= 1 And Cells(rw, col) <= 9.9 And _
            Cells(rw, col + 1) = "" Then Cells(rw, col).NumberFormat = "#,#0.0 "
        
        If Cells(rw, col) >= 1 And Cells(rw, col) <= 9.9 And Cells(rw, col + 1) = "D" Then _
            Cells(rw, col).NumberFormat = "#,###0.0 "
        
        If Cells(rw, col) >= 10 And Cells(rw, col + 1) = "D" Then _
            Cells(rw, col).NumberFormat = "#,### "
            
        If Cells(rw, col) >= 10 And Cells(rw, col + 1) = "" Then _
            Cells(rw, col).NumberFormat = "#,### "
  
  Next
 Next
End Sub

[TABLE="width: 675"]
<tbody>[TR]
[TD="class: xl65, width: 203, align: center"]Col A[/TD]
[TD="class: xl65, width: 109, align: center"]Col B[/TD]
[TD="class: xl65, width: 71, align: center"]Col C[/TD]
[TD="class: xl65, width: 71, align: center"]Col D[/TD]
[TD="class: xl65, width: 71, align: center"]Col E[/TD]
[TD="class: xl65, width: 71, align: center"]Col F[/TD]
[TD="class: xl65, width: 79, align: center"]Col G[/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="width: 675"]
<tbody>[TR]
[TD]CONSTIUTENTS[/TD]
[TD]Cleanup Levels[/TD]
[TD]MW-01[/TD]
[TD]MW-02[/TD]
[TD]MW-03[/TD]
[TD="align: center"]MW-04[/TD]
[TD] MW-05[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Dichlorodifluoromethane[/TD]
[TD][/TD]
[TD]1.00 U[/TD]
[TD]1.00 U[/TD]
[TD]1.00 U[/TD]
[TD]1.00 U[/TD]
[TD]1 U[/TD]
[/TR]
[TR]
[TD]Chloromethane[/TD]
[TD][/TD]
[TD]0.500 U[/TD]
[TD]0.500 U[/TD]
[TD]0.500 U[/TD]
[TD]0.500 U[/TD]
[TD]0.5 U[/TD]
[/TR]
[TR]
[TD]Vinyl chloride[/TD]
[TD]525[/TD]
[TD]6.06[/TD]
[TD]0.48[/TD]
[TD]141[/TD]
[TD]0.200 U[/TD]
[TD]0.2 U[/TD]
[/TR]
[TR]
[TD]Bromomethane[/TD]
[TD][/TD]
[TD]0.500 U[/TD]
[TD]0.500 U[/TD]
[TD]0.500 U[/TD]
[TD]0.500 U[/TD]
[TD]0.5 U[/TD]
[/TR]
[TR]
[TD]Trichlorofluoromethane[/TD]
[TD][/TD]
[TD]0.500 U[/TD]
[TD]0.500 U[/TD]
[TD]0.500 U[/TD]
[TD]0.500 U[/TD]
[TD]0.5 U[/TD]
[/TR]
[TR]
[TD]Chloroethane[/TD]
[TD][/TD]
[TD]0.500 U[/TD]
[TD]0.500 U[/TD]
[TD]0.500 U[/TD]
[TD]0.500 U[/TD]
[TD]0.5 U[/TD]
[/TR]
[TR]
[TD]1,1-Dichloroethene[/TD]
[TD]3.2[/TD]
[TD]0.500 U[/TD]
[TD]0.500 U[/TD]
[TD]1.8[/TD]
[TD]0.500 U[/TD]
[TD]0.5 U[/TD]
[/TR]
[TR]
[TD]Acetone[/TD]
[TD][/TD]
[TD]2.00 U[/TD]
[TD]2.00 U[/TD]
[TD]2.00 U[/TD]
[TD]2.00 U[/TD]
[TD]2 U[/TD]
[/TR]
[TR]
[TD]Methylene chloride[/TD]
[TD][/TD]
[TD]0.500 U[/TD]
[TD]0.500 U[/TD]
[TD]0.500 U[/TD]
[TD]0.500 U[/TD]
[TD]0.5 U[/TD]
[/TR]
[TR]
[TD]trans-1,2-Dichloroethene[/TD]
[TD]32,000[/TD]
[TD]0.55[/TD]
[TD]0.500 U[/TD]
[TD]89.4[/TD]
[TD]0.500 U[/TD]
[TD]0.5 U[/TD]
[/TR]
[TR]
[TD]1,1-Dichloroethane[/TD]
[TD][/TD]
[TD]0.98[/TD]
[TD]0.500 U[/TD]
[TD]5.85[/TD]
[TD]0.500 U[/TD]
[TD]0.5 U[/TD]
[/TR]
[TR]
[TD]2,2-Dichloropropane[/TD]
[TD][/TD]
[TD]1.00 U[/TD]
[TD]1.00 U[/TD]
[TD]1.00 U[/TD]
[TD]1.00 U[/TD]
[TD]1 U[/TD]
[/TR]
[TR]
[TD]cis-1,2-Dichloroethene[/TD]
[TD][/TD]
[TD]56.6[/TD]
[TD]88.1[/TD]
[TD]3,170[/TD]
[TD]0.500 U[/TD]
[TD]0.5 U[/TD]
[/TR]
</tbody>[/TABLE]
 
Sort by date Sort by votes
This assumes that your headers begin in A1 and your data in A2 (your post makes it look like there is an empty row between the data and the headers), and that the range you want to format is C:G.
Code: 
Sub ChangeNumberFormat()
Dim vA As Variant, lR As Long, vC As Variant
lR = Range("A1").CurrentRegion.Rows.Count
Range("C2", "G" & lR).NumberFormat = "@"
vA = Range("C2", "G" & lR).Value
For i = LBound(vA, 1) To UBound(vA, 1)
    For j = LBound(vA, 2) To UBound(vA, 2)
        vC = Split(vA(i, j), " ")
        For k = LBound(vC) To UBound(vC)
            If IsNumeric(vC(k)) Then
                Select Case vC(k)
                    Case Is < 1: vC(k) = WorksheetFunction.Text(vC(k), "0.000")
                    Case Is <= 9.9: vC(k) = WorksheetFunction.Text(vC(k), "0.00")
                    Case Is < 100: vC(k) = WorksheetFunction.Text(vC(k), "0.0")
                    Case Else: vC(k) = WorksheetFunction.Text(vC(k), "0")
                    
                End Select
            End If
        Next k
        vA(i, j) = CStr(Join(vC, " "))
    Next j
Next i
Range("C2", "G" & lR).Value = vA
End Sub
 
Upvote 0
JoeMo,

Thanks! (both for helping me with this and also for pointing out the double-post, question: can I delete the second post?). That macro worked for me. I'll tweak it a bit as my data actually starts at cell C3. Also I'm going to modify your code to work with the user being asked to select a range. I have some code that does other, simpler modifications to the data (make a blue colored cell if the data is above a certain value), and I can use that code with yours (at least I THINK I can!).


Again, thanks!

stb
 
Upvote 0
JoeMo said:
This assumes that your headers begin in A1 and your data in A2 (your post makes it look like there is an empty row between the data and the headers), and that the range you want to format is C:G.
Rich (BB code): 
Sub ChangeNumberFormat()
Dim vA As Variant, lR As Long, vC As Variant
lR = Range("A1").CurrentRegion.Rows.Count
Range("C2", "G" & lR).NumberFormat = "@"
vA = Range("C2", "G" & lR).Value
For i = LBound(vA, 1) To UBound(vA, 1)
    For j = LBound(vA, 2) To UBound(vA, 2)
        vC = Split(vA(i, j), " ")
        For k = LBound(vC) To UBound(vC)
            If IsNumeric(vC(k)) Then
                Select Case vC(k)
                    Case Is < 1: vC(k) = WorksheetFunction.Text(vC(k), "0.000")
                    Case Is <= 9.9: vC(k) = WorksheetFunction.Text(vC(k), "0.00")
                    Case Is < 100: vC(k) = WorksheetFunction.Text(vC(k), "0.0")
                    Case Else: vC(k) = WorksheetFunction.Text(vC(k), "0")
                    
                End Select
            End If
        Next k
        vA(i, j) = CStr(Join(vC, " "))
    Next j
Next i
Range("C2", "G" & lR).Value = vA
End Sub
Click to expand...
VBA has the built-in Format function which, for the requested functionality, works identically to the WorksheetFunction's Text method... it will be more efficient in the long run to use the Format function here... just replace the text I highlighted above with the word Format
 
Upvote 0
Rick Rothstein said:
VBA has the built-in Format function which, for the requested functionality, works identically to the WorksheetFunction's Text method... it will be more efficient in the long run to use the Format function here... just replace the text I highlighted above with the word Format
Click to expand...
Thanks for the pointer Rick, the Format function simply didn't come to mind.
 
Upvote 0
JoeMo said:
Thanks for the pointer Rick, the Format function simply didn't come to mind.
Click to expand...
Just to be clear for this thread, the Format function is not a direct nor exact replacment for the Worksheetfunction.Text method, so one needs to understand their differences when deciding on which one to use; however, the particular core functionality for what the OP asked for in this thread is identical for both of them which is why I was able to suggest using one in place of the other.
 
Upvote 0
Joe,

If it wouldn't be too much trouble, and only if you have the time, could you add comments explaining the lines of code? VBA is a steep learning curve, and while I love to be handed a fish, I'm trying to learn how to fish... :hungry:


I get the Select Case bit, but the array functions has my head in a twist. Question: with the data that has the correct format, is the code skipping by since it is already formatted, or is it actually formatting it anyway (just not observable since no change is necessary)?

Thanks!


stb (a.k.a Russell)
 
Upvote 0
seattletimebandit said:
Joe,

If it wouldn't be too much trouble, and only if you have the time, could you add comments explaining the lines of code? VBA is a steep learning curve, and while I love to be handed a fish, I'm trying to learn how to fish... :hungry:


I get the Select Case bit, but the array functions has my head in a twist. Question: with the data that has the correct format, is the code skipping by since it is already formatted, or is it actually formatting it anyway (just not observable since no change is necessary)?

Thanks!


stb (a.k.a Russell)
Click to expand...
The variant array captures all the data initially and places it in memory. The advantage of this is that one can now process the data in memory rather than cell by cell which is a much slower process. The code now goes through every array element (effectively, every cell value, but much faster) and splits the content into separate pieces - so 0.5 U gets split into 0.5 and U. It then examines each piece to see if it is a number, and if so uses the select case to format it per your guidelines. Nothing gets skipped, even if it already meets the guidelines, but again, all done in memory so there is virtually no process time downside. At the last step the initial data range is changed in one shot by dumping the modified array back into the data range.
 
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Solved
VBA Font Conditional Formatting based on cell value change - but it doesn't trigger
Replies
3
Views
231
hcgood
H
B
  • Question Question
Suggestions for Building a Historical Cost Database by Project
Replies
0
Views
142
babyjwhale
B
G
  • Solved
Skins Game Conditional Formatting
2
Replies
16
Views
2K
Peter_SSs
Peter_SSs
D
  • Question Question
Format number as $M or $K based on cell value - millions / thousands
Replies
1
Views
5K
BigBeachBananas
B
G
  • Solved
Format & Protect range of cells using VBA
Replies
7
Views
1K
Gajendran Yadhav
G

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top