VBA format cell if is text and not a numeric value

**Grimace** · 03-07-2011, 11:33 PM

Hi all,

I am currently using the below VBA code to do a conditional format with more than 3 options, and it is working fine.

What I would like to add is an operator to check if the cell is text instead of a number, and if so format in a different colour (ie Black background and white text). This should overide all other formatting if the cell contains text.

Any suggestions on what to use? I am thinking an isnum type function but not too familiar with the VBA coding equivalent.

My current code is:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim MyRange As Range, cell As Range
Set MyRange = Range("b2:m35")
For Each cell In MyRange
    
        If cell.Value <= [i38].Value Then
            cell.Interior.ColorIndex = 3
        End If
        
        If cell.Value >= [f38].Value Then
            cell.Interior.ColorIndex = 45
        End If
                
        If cell.Value >= [d38].Value Then
            cell.Interior.ColorIndex = 27
        End If
                
        If cell.Value >= [b38].Value Then
            cell.Interior.ColorIndex = 4
        End If
        
        If cell.Value = "" Then
            cell.Interior.ColorIndex = 2
        End If
        
    Next
    
End Sub

Thanks

**Leith Ross** · 03-08-2011, 01:59 AM

Hello Grimace,

If I understand what you want to then this version of the macro should do it. Try it and let me know the outcome.

Private Sub Worksheet_Change(ByVal Target As Range)

  Dim CellType As Integer
  Dim CI As Long
  Dim FC As Long
  Dim MyRange As Range
  
    Set MyRange = Range("B2:M35")
    
     'Exit if the selected cell or cells are not part of MyRange
      If Intersect(Target, MyRange) Is Nothing Then Exit Sub
      
      For Each cell In Target
      
        CellType = VarType(Target)
        
          'Test if Target value is text
           If CellType = vbString Then
              cell.Interior.ColorIndex = 1
              cell.Font.ColorIndex = 2
           Else
             'Value must be an Integer, Long, Single or Double
              If CellType > 1 And CellType < 6 Then
              
                 Select Case cell.Value
                   Case Is <= Range("I38")
                       CI = 3
                   Case Is >= Range("F38")
                       CI = 45
                   Case Is >= Range("D38")
                       CI = 27
                   Case Is >= Range("B38")
                       CI = 4
                   Case Else
                       CI = xlColorIndexNone
                       FC = xlColorIndexAutomatic
                 End Select
              
                cell.Interior.ColorIndex = CI
                cell.Font.ColorIndex = FC
                
              End If
           End If
        
      Next cell
    
End Sub

**Grimace** · 03-08-2011, 02:06 AM

Hi Leith Ross, thanks for the prompt reply.

I entered this code and I tried entering a text value into a cell ---- received an error of "unable to set the ColorIndex property of the interior class" ....

**Leith Ross** · 03-08-2011, 02:22 AM

Hello Grimace,

I knew this would probably happen since I didn't have your workbook to check the code against. Can you post a copy of the workbook?

**Grimace** · 03-08-2011, 10:54 PM

Thanks Leith Ross,

Please find workbook attached.

Darren.

**Leith Ross** · 03-09-2011, 02:03 AM

Hello Darren,

You have to remove the worksheet protection before the cell's color can be changed. Change the password in the code below. It is marked in bold.

Delete the old macro and copy this one in its place.

Private Sub Worksheet_Change(ByVal Target As Range)

  Dim cell As Range
  Dim CellType As Integer
  Dim CI As Long
  Dim FC As Long
  Dim MyRange As Range
  
    ActiveSheet.Unprotect Password:="123"
    
    Set MyRange = Range("B2:M35")
    
     'Exit if the selected cell or cells are not part of MyRange
      If Intersect(Target, MyRange) Is Nothing Then Exit Sub
      
      For Each cell In Target
      
        CellType = VarType(cell)
        
          'Test if Target value is text
           If CellType = vbString Then
              cell.Interior.ColorIndex = 1
              cell.Font.ColorIndex = 2
           Else
             'Value must be an Integer, Long, Single or Double
              If CellType > 1 And CellType < 6 Then
              
                 Select Case cell.Value
                   Case Is <= Range("I38")
                       CI = 3
                   Case Is >= Range("F38")
                       CI = 45
                   Case Is >= Range("D38")
                       CI = 27
                   Case Is >= Range("B38")
                       CI = 4
                   Case Else
                       CI = xlColorIndexNone
                       FC = xlColorIndexAutomatic
                 End Select
              
                cell.Interior.ColorIndex = CI
                cell.Font.ColorIndex = FC
                
              End If
           End If
        
      Next cell
    
    ActiveSheet.Protect  Password:= "123"
    
End Sub

**Grimace** · 03-09-2011, 02:16 AM

Hi Leith Ross

Thanks for the reply, the code appears to change any new items that I key in to the correct format.

I have encountered 2 issues though.

The first is that any text already on the sheet stays as it was, until I rekey it, then turning it white on black as required..

The second is that the other colour coding in the sheet seems to now be out of whack. I rekeyed some of the values, and they are all changing to red background regardless of the value entered. I found this happening when sorting out my original code, and had to make sure it was in the correct order to generate the correct outcome (ie entering a value of 22 should format the cell as yellow background, being less than 24.99 ..... however given it is also less than 34.99 and less than 200 200, it appears that the colouring is first changed to yellow, then orange, and then finally red.

Darren

**Grimace** · 03-14-2011, 10:47 PM

Hi all,

Any chance there could be some more inputs on this one? I am guessing it is nearly there, just the order that is wrong?

Darren

**Leith Ross** · 03-15-2011, 01:07 AM

Hello Darren,

Here is the revised macro. This will color the cells based on the values in row 38. The attached workbook has the macro installed. All the previous cells have had their colors updated. Be sure to change the password.

Private Sub Worksheet_Change(ByVal Target As Range)

  Dim cell As Range
  Dim CellType As Integer
  Dim CI As Long
  Dim FC As Long
  Dim MyRange As Range
  
    ActiveSheet.Unprotect Password:="123"
    
    Set MyRange = Range("B2:M35")
    
     'Exit if the selected cell or cells are not part of MyRange
      If Intersect(Target, MyRange) Is Nothing Then Exit Sub
      
      For Each cell In Target
      
        CellType = VarType(cell)
        
          'Test if Target value is text
           If CellType = vbString Then
              cell.Interior.ColorIndex = 3
              cell.Font.ColorIndex = 2
           Else
             'Value must be an Integer, Long, Single or Double
              If CellType > 1 And CellType < 6 Then
              
                 Select Case cell.Value
                   Case Range("H38") To Range("I38")
                       CI = 3
                   Case Range("F38") To Range("G38")
                       CI = 45
                   Case Range("D38") To Range("E38")
                       CI = 27
                   Case Range("B38") To Range("C38")
                       CI = 4
                   Case Else
                       CI = xlColorIndexNone
                       FC = xlColorIndexAutomatic
                 End Select
              
                cell.Interior.ColorIndex = CI
                cell.Font.ColorIndex = FC
                
              End If
           End If
        
      Next cell
    
    ActiveSheet.Protect Password:="123"
    
End Sub

**Grimace** · 03-16-2011, 08:45 PM

Thanks Leith Ross, I think it is almost there.

I have used the code across a number of sheets and been able to adapt it to the scenarios. I also added a line to remove the fill if the value in the cell is deleted.

One issue i have found is that if a value of 0.00 is entered, it colours oprange instead of green? I have checked the cell references and they are all correct, so am a bit lost now. Any ideas?

I have attached the sheet where it happens as an example for you.

Darren.

**Leith Ross** · 03-16-2011, 11:10 PM

Hello Grimace,

This macro will ignore limit cells that are empty. There must be both a lower and upper limit for a test to be valid. The cell colors have been moved into an array to make selection easier.

Private Sub Worksheet_Change(ByVal Target As Range)

  Dim arrColors As Variant
  Dim cell As Range
  Dim CellType As Integer
  Dim CI As Long
  Dim ColorRng As Range
  Dim FC As Long
  Dim I As Long
  Dim MyRange As Range
  Dim Test1 As Range
  Dim Test2 As Range
  
    ActiveSheet.Unprotect Password:="Virgin11"
    
    Set MyRange = Range("B2:M35")
    Set ColorRng = Range("B38:I38")
    
     'Exit if the selected cell or cells are not part of MyRange
      If Intersect(Target, MyRange) Is Nothing Then Exit Sub
      
     'Cell colors for test ranges
      arrColors = Array(4, 45, 27, 3)
      
      For Each cell In Target
      
        CellType = VarType(cell)
        
       'Default cell and font colors
        CI = xlColorIndexNone
        FC = xlColorIndexAutomatic
        
          'Test if Target value is text
           If CellType = vbString Then
              cell.Interior.ColorIndex = 1
              cell.Font.ColorIndex = 2
           Else
             'Value must be an Integer, Long, Single or Double
              If CellType > 1 And CellType < 6 Then
              
                For I = 1 To ColorRng.Cells.Count Step 2
                 'Get the lower and upper test range limits
                  Set Test1 = ColorRng.Cells(1, I)
                  Set Test2 = Test1.Offset(0, 1)
                  
                 'Get the test range color if the cell value is in limits
                 'Don't test if one or both limits is/are empty cells
                  If Test1.Value <> "" And Test2.Value <> "" Then
                    If cell >= Test1 And cell <= Test2 Then
                       CI = arrColors(I \ 2)
                    End If
                  End If
                Next I
                              
                cell.Interior.ColorIndex = CI
                cell.Font.ColorIndex = FC
                
              End If
            
           End If
        
      Next cell
    
    ActiveSheet.Protect Password:="Virgin11"
    
End Sub

**Grimace** · 03-22-2011, 10:45 PM

Thanks very much Leith Ross for the coding, however I must admit you have lost me a little on the structure with this last one. Moving colours into an array has me stumped, and I recognise it is most probably due to my limited knowledge of using arrays in formula.

Everything appears to be working perfectly now

You had me going for a second in that the colours were a bit askew, but I identified that you had transposed 2 colour numbers in the array (what should have turned yellow was turing orange, and vice versa)

I am assuming you threw that one in as a little test to see if I really read what you coded, or just blindly copied and pasted

Thanks again.

Darren.

**Grimace** · 04-13-2011, 06:20 PM

Hi Leith Ross,
Not sure if I should start a new thread for this? So apologies if I should.
Re the above thread, I have added one sheet to my workbook as a summary, and am trying to adapt the code you have already provided me with no luck. So I have gone with a very basic format.

I am running into one issue, in getting the test if Text function to work. As this sheet doesnt have the same basic structure as the others, and 8 different criteria and matching colouring tests, it all went haywire ....

Below is one section of the code, and I am just changing the ranges and repeating the process all the way down the sheet. It still wont change the text cells to white on black though? The entire workbook still works perfectly apart from this one sheet that I added, any advice would be greatly appreciated?

I tried the cell.type test, but it errored saying "not accepted."

The sheet i have added is the Team Member Dashboard, and each of the rows in the table has the relevant colour coding in rows 29:42.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim MyRange As Range, Cell As Range
Set MyRange = Range("b2:m2")
ActiveSheet.Unprotect Password:="Virgin11"
For Each Cell In MyRange
    
        If Cell.Value <= [i29].Value Then
            Cell.Interior.ColorIndex = 3
        End If
        
        If Cell.Value >= [f29].Value Then
            Cell.Interior.ColorIndex = 45
        End If
                
        If Cell.Value >= [d29].Value Then
            Cell.Interior.ColorIndex = 27
        End If
                
        If Cell.Value >= [b29].Value Then
            Cell.Interior.ColorIndex = 4
        End If
        
        If Cell.Value = "" Then
            Cell.Interior.ColorIndex = 2
        End If
        
        If Cell.Value = vbString Then
              Cell.Interior.ColorIndex = 1
              Cell.Font.ColorIndex = 2
        End If
        
    Next

VBA format cell if is text and not a numeric value

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

VBA format cell if is text and not a numeric value

Re: VBA format cell if is text and not a numeric value

Re: VBA format cell if is text and not a numeric value

Re: VBA format cell if is text and not a numeric value

Re: VBA format cell if is text and not a numeric value

Re: VBA format cell if is text and not a numeric value

Re: VBA format cell if is text and not a numeric value

Re: VBA format cell if is text and not a numeric value

Re: VBA format cell if is text and not a numeric value

Re: VBA format cell if is text and not a numeric value

Re: VBA format cell if is text and not a numeric value

Re: VBA format cell if is text and not a numeric value

Re: VBA format cell if is text and not a numeric value

Thread Information

Users Browsing this Thread

Bookmarks

Bookmarks

Posting Permissions