Marco tha changes number format of text values

seattletimebandit · Apr 25, 2013

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

Col A

Col B

Col C

Col D

Col E

Col F

Col G

CONSTIUTENTS	Cleanup Levels	MW-01	MW-02	MW-03	MW-04	MW-05

Dichlorodifluoromethane		1.00 U	1.00 U	1.00 U	1.00 U	1 U
Chloromethane		0.500 U	0.500 U	0.500 U	0.500 U	0.5 U
Vinyl chloride	525	6.06	0.48	141	0.200 U	0.2 U
Bromomethane		0.500 U	0.500 U	0.500 U	0.500 U	0.5 U
Trichlorofluoromethane		0.500 U	0.500 U	0.500 U	0.500 U	0.5 U
Chloroethane		0.500 U	0.500 U	0.500 U	0.500 U	0.5 U
1,1-Dichloroethene	3.2	0.500 U	0.500 U	1.8	0.500 U	0.5 U
Acetone		2.00 U	2.00 U	2.00 U	2.00 U	2 U
Methylene chloride		0.500 U	0.500 U	0.500 U	0.500 U	0.5 U
trans-1,2-Dichloroethene	32,000	0.55	0.500 U	89.4	0.500 U	0.5 U
1,1-Dichloroethane		0.98	0.500 U	5.85	0.500 U	0.5 U
2,2-Dichloropropane		1.00 U	1.00 U	1.00 U	1.00 U	1 U
cis-1,2-Dichloroethene		56.6	88.1	3,170	0.500 U	0.5 U

seattletimebandit · Feb 27, 2017

Hello Again!

Need some assistance with an old post. I was revisiting some of the code I had been discussing back in 2013. I had mentioned about changing the interior.color of cells based on comparing to numbers in Column B ("Cleanup Levels") of the table discussed here. The problem is that when I create a table on a blank worksheet, I can get the correct cells to change color that IsNumeric And the cell number is >= the number in Column B for that row if a number exists. However, I seem to have a problem when creating a table of data from another source. When I run the macro, if there is a Cleanup Level number in Column B ALL numbers in the corresponding row change color, even if the number is < the number in Column B. The If Then statement: If c2 <> "" And IsNumeric(c2) And c2 >= c1 Then shouldn't let that happen. Is this an issue with a pre-formatted worksheet? I clear the formatting, but still all numbers in the row are colored. Weird. Thoughts?

Thanks in advance!!

The code (the part I'm discussing is highlighted in green):

Code:

Sub CleanupLevels()

'created by Russell Stolsen, 4/13/13

Application.ScreenUpdating = True
    
Dim lastColumn As Integer 'find last column in table
Dim c1 As Range 'column that has cleanup level data
Dim c2 As Range 'rows that has data to be compared to cleanup levels, if applicable
Dim response    'message box
    
    response = MsgBox("This macro will modify your table, do you want to proceed?", vbQuestion + vbYesNo + vbDefaultButton2, "Identify Cleanup Level Exceedances") '
    If response = vbYes Then
    
    'message box that asks user to pick cells in Cleanup Level column,
    'user can pick 1 cell or several including blanks
    On Error GoTo Canceled 'exit macro if user clicks Cancel button
    Set c1 = Application.InputBox("Select all cells in Cleanup Levels column" & vbCrLf & "(you can pick one cell or the whole column)", "Select Cleanup Levels", Type:=8)
    
    Application.ScreenUpdating = False
        'in case the user might choose outside the range of the Cleanup Levels column, give the user a chance to cancel
    response = MsgBox("Are you sure you picked the correct column?" & vbCrLf & "If you're not sure, cancel and try again!", vbExclamation + vbYesNo + vbDefaultButton2, "Warning") '
    If response = vbYes Then
        For Each c1 In c1.Cells                                                         'once range is picked start checking cells in Cleanup Level column
            If c1 <> "" And IsNumeric(c1) Then                                          'if a cell is blank or has a number
            lastColumn = ActiveSheet.Cells(c1.Row, Columns.Count).End(xlToLeft).Column  'then find the last column
                [COLOR=#008000]For Each c2 In Range(Cells(c1.Row, 3), Cells(c1.Row, lastColumn))      [/COLOR] 'now start moving through the first cell to the right[COLOR=#008000]
                    If c2 <> "" And IsNumeric(c2) And c2 >= c1 Then [/COLOR]                 'checking if the cell is blank or has a number, will ignore blanks and non-numbers like "0.500 U"
                                                                                        'and check to see if the number is greater than or equal to the number in the Cleanup Level cell
                        [COLOR=#008000]c2.Interior.Color = RGB(197, 217, 241)  [/COLOR]                        'if the number is >= then fill the cell color identifying it as an exceedance
                    End If
                Next c2                                                                 'loop to the next cell
            End If
        Next c1                                                                         'when finished with the row at the last column move down to the next number in Cleanup Level column
            Application.ScreenUpdating = True
        Else
            Exit Sub                                                                    'quit macro if user decides not to continue
        End If
    Else
        Exit Sub                                                                        'quit macro if user decides not to continue
    End If
Canceled:                                                                               'quit macro if user decides not to select

End Sub

Col A

Col B

Col C

Col D

Col E

Col F

Col G

CONSTIUTENTS	Cleanup Levels	MW-01	MW-02	MW-03	MW-04	MW-05

Dichlorodifluoromethane		1.00 U	1.00 U	1.00 U	1.00 U	1 U
Chloromethane		0.500 U	0.500 U	0.500 U	0.500 U	0.5 U
Vinyl chloride	5	6.06	0.48	141	0.200 U	0.2 U
Bromomethane		0.500 U	0.500 U	0.500 U	0.500 U	0.5 U
Trichlorofluoromethane		0.500 U	0.500 U	0.500 U	0.500 U	0.5 U
Chloroethane		0.500 U	0.500 U	0.500 U	0.500 U	0.5 U
1,1-Dichloroethene	1.0	0.500 U	0.500 U	1.8	0.500 U	0.5 U
Acetone		2.00 U	2.00 U	2.00 U	2.00 U	2 U
Methylene chloride		0.500 U	0.500 U	0.500 U	0.500 U	0.5 U
trans-1,2-Dichloroethene	75	0.55	0.500 U	89.4	0.500 U	0.5 U
1,1-Dichloroethane		0.98	0.500 U	5.85	0.500 U	0.5 U
2,2-Dichloropropane		1.00 U	1.00 U	1.00 U	1.00 U	1 U
cis-1,2-Dichloroethene		56.6	88.1	3,170	0.500 U	0.5 U

JoeMo · Feb 27, 2017

seattletimebandit said:
Hello Again!

Need some assistance with an old post. I was revisiting some of the code I had been discussing back in 2013. I had mentioned about changing the interior.color of cells based on comparing to numbers in Column B ("Cleanup Levels") of the table discussed here. The problem is that when I create a table on a blank worksheet, I can get the correct cells to change color that IsNumeric And the cell number is >= the number in Column B for that row if a number exists. However, I seem to have a problem when creating a table of data from another source. When I run the macro, if there is a Cleanup Level number in Column B ALL numbers in the corresponding row change color, even if the number is < the number in Column B. The If Then statement: If c2 <> "" And IsNumeric(c2) And c2 >= c1 Then shouldn't let that happen. Is this an issue with a pre-formatted worksheet? I clear the formatting, but still all numbers in the row are colored. Weird. Thoughts?

Thanks in advance!!

Having only taken a quick look at your post, I'm guessing from the alignment of the col B data that your "other source" is entering text not numbers in col B.

seattletimebandit · Feb 27, 2017

Joe,

Thanks for the quick response! I I don't know if this link to my Dropbox will work, but it has two tables to run the macro. The table on Sheet1 works as it should, the other (Sheet2) does what I explained in my post. If you could give it a run, maybe you can see where the issue is. I'm just not finding out why it's not working correctly in the second table.

Note the macro in this workbook doesn't require selecting ColB. The Range is hard-coded.

https://dl.dropboxusercontent.com/u/25599137/ExampleTable.xls

JoeMo · Feb 27, 2017

seattletimebandit said:
Joe,

Thanks for the quick response! I I don't know if this link to my Dropbox will work, but it has two tables to run the macro. The table on Sheet1 works as it should, the other (Sheet2) does what I explained in my post. If you could give it a run, maybe you can see where the issue is. I'm just not finding out why it's not working correctly in the second table.

Note the macro in this workbook doesn't require selecting ColB. The Range is hard-coded.

https://dl.dropboxusercontent.com/u/25599137/ExampleTable.xls

Sorry, I don't download files from the internet. You didn't comment on the point of my post which was to suggest that your problem may lie in the format of your "data from another source". It may not be what you think it is. In particular, what appear to be numbers may actually be text.

seattletimebandit · Feb 27, 2017

Understood about not downloading from strangers. Best to be safe.

I didn't respond to your "data from another source" thought, because I'm not entirely clear what you mean. Although I did think that it must be a cell formatting issue, but changing formats still doesn't work.

I cleared the format in ColB and the format of all cells in the body of the table. And have tried formatting as "General", and "Number". But I still get all cells w/o a "U" to turn color. In my original table that I created so long ago with some help (code below), works just fine.

Thanks for taking time to respond. As always, much appreciated.

Russell

Code:

Sub GreaterThanCULs()
    Application.ScreenUpdating = False
    Dim lastColumn As Integer
    Dim c1 As Range
    Dim c2 As Range
    For Each c1 In Range("b3:b100")
        If c1 <> "" And IsNumeric(c1) Then
        lastColumn = ActiveSheet.Cells(c1.Row, Columns.Count).End(xlToLeft).Column
            For Each c2 In Range(Cells(c1.Row, 3), Cells(c1.Row, lastColumn))
                If c2 <> "" And IsNumeric(c2) And c2 >= c1 Then
                    c2.Interior.ColorIndex = 3
                End If
            Next c2
        End If
    Next c1
    Application.ScreenUpdating = True
End Sub

JoeMo · Feb 27, 2017

seattletimebandit said:
Understood about not downloading from strangers. Best to be safe.

I didn't respond to your "data from another source" thought, because I'm not entirely clear what you mean. Although I did think that it must be a cell formatting issue, but changing formats still doesn't work.

I cleared the format in ColB and the format of all cells in the body of the table. And have tried formatting as "General", and "Number". But I still get all cells w/o a "U" to turn color. In my original table that I created so long ago with some help (code below), works just fine.

Thanks for taking time to respond. As always, much appreciated.

Russell

Code:

Sub GreaterThanCULs() Application.ScreenUpdating = False Dim lastColumn As Integer Dim c1 As Range Dim c2 As Range For Each c1 In Range("b3:b100") If c1 <> "" And IsNumeric(c1) Then lastColumn = ActiveSheet.Cells(c1.Row, Columns.Count).End(xlToLeft).Column For Each c2 In Range(Cells(c1.Row, 3), Cells(c1.Row, lastColumn)) If c2 <> "" And IsNumeric(c2) And c2 >= c1 Then c2.Interior.ColorIndex = 3 End If Next c2 End If Next c1 Application.ScreenUpdating = True End Sub

In any empty cell enter this formula (change the address to a col B cell that has a number in it if necessary):

=ISNUMBER(B5)

What do you get?

seattletimebandit · Feb 27, 2017

I get "TRUE" with a number and "FALSE" if cell is empty

seattletimebandit · Feb 27, 2017

Can I post jpegs of screen caps of one worksheet that the macro works and another that it doesn't work? They will paste in the reply window, but if it's considered an attachment, then I won't do that.

JoeMo · Feb 27, 2017

seattletimebandit said:
Can I post jpegs of screen caps of one worksheet that the macro works and another that it doesn't work? They will paste in the reply window, but if it's considered an attachment, then I won't do that.

You can post portions of your sheets, using one of the tools at the links below, that can be copied from a browser and pasted directly into Excel. Posting pictures is a bad idea b/c most of us are not willing to re-enter your data to test it.

Excel Jeanie link: Download
MrExcel HTML Maker link: http://www.mrexcel.com/forum/2545970-post2.html

Marco tha changes number format of text values

seattletimebandit

Board Regular

seattletimebandit

Board Regular

Excel Facts

JoeMo

MrExcel MVP

seattletimebandit

Board Regular

JoeMo

MrExcel MVP

seattletimebandit

Board Regular

JoeMo

MrExcel MVP

seattletimebandit

Board Regular

seattletimebandit

Board Regular

JoeMo

MrExcel MVP

Similar threads

Forum statistics

Share this page

Marco tha changes number format of text values

Board Regular

Board Regular

Excel Facts

MrExcel MVP

Board Regular

MrExcel MVP

Board Regular

MrExcel MVP

Board Regular

Board Regular

MrExcel MVP

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