[RESOLVED] (VBA) Color row if cell contains a number

[Radjesh Klauke]

Hi,

Anyone with a code that colors the row where the cell in a specific column contains a number. The cell also contains text.

example:

A1  - radjesh
A2  - radjesh 2
A3  - apple
A4  - yummy 5

After the code rows 2 and 4 should be colored.

Thanks in advance.

[vbfbryce]

If your data is in column A, starting in row 1, this code will color each row blue if there is a number within the value in column A:

Sub colorRow()
    Dim i As Long
    Dim j As Long
    Dim LR As Long
    Dim charCount As Integer
    
    LR = Range("a" & Rows.Count).End(xlUp).Row
    For i = 1 To LR
        charCount = Len(Range("a" & i).Value)
        For j = 1 To charCount
            If IsNumeric(Mid(Range("a" & i).Value, j, 1)) Then
                Range("a" & i).EntireRow.Interior.Color = vbBlue
                GoTo BailOut
            End If
        Next j
BailOut:
    Next i
End Sub

[Radjesh Klauke]

Thanks m8.

[Numborero]

Hi Bryce

Ohh That's a great MAcro and almost what I need Hope you could help?
Would it be possible to ad something to this?

I would like to ad the folowing as now when Collum K has a value then the row turns green.
In adition to this I need rows to be turned Blue when the row in collum K and M both contain a numeric value.

Could you help me with this?


Sub colorRow()
Dim i As Long
Dim j As Long
Dim LR As Long
Dim charCount As Integer

LR = Range("k" & Rows.Count).End(xlUp).Row
For i = 1 To LR
charCount = Len(Range("k" & i).Value)
For j = 1 To charCount
If IsNumeric(Mid(Range("k" & i).Value, j, 1)) Then
Range("k" & i).EntireRow.Interior.Color = vbGreen
GoTo BailOut
End If
Next j
BailOut:
Next i

End Sub


Kind regards,

Arne

[Numborero]

Re done the text...

Hi Bryce

Ohh That's a great MAcro and almost what I need Hope you could help?
Would it be possible to ad something to this?

I would like to ad the folowing as now when Collum K has a value then the row turns green.
In adition to this I need the row to be turned Blue when in collum K and M both contain a numeric value on the same row.

Could you help me with this?


Sub colorRow()
Dim i As Long
Dim j As Long
Dim LR As Long
Dim charCount As Integer

LR = Range("k" & Rows.Count).End(xlUp).Row
For i = 1 To LR
charCount = Len(Range("k" & i).Value)
For j = 1 To charCount
If IsNumeric(Mid(Range("k" & i).Value, j, 1)) Then
Range("k" & i).EntireRow.Interior.Color = vbGreen
GoTo BailOut
End If
Next j
BailOut:
Next i

End Sub


Kind regards,

Arne

This is absolutely cool stuff! Hope you can help

[vbfbryce]

something like this:

Sub colorRows()
    Dim i As Long
    'Dim j As Long
    Dim lrK As Long     'last row with a filled cell in column K
    Dim lrM As Long     'last row with a filled cell in column M
    Dim lr As Long      'max of lrK and lrM
    Dim ws As Worksheet
    
    Set ws = ActiveSheet
    
    lrK = Range("k" & Rows.Count).End(xlUp).Row
    lrM = Range("m" & Rows.Count).End(xlUp).Row
    lr = Application.WorksheetFunction.Max(lrK, lrM)
    
    For i = 1 To lr     'my data starts in row 1, otherwise change this
        If IsNumeric(ws.Range("k" & i).Value) Then
            If IsNumeric(ws.Range("m" & i).Value) Then
                'both K and M have a numeric value, so BLUE
                ws.Range("a" & i).EntireRow.Interior.Color = vbBlue
            Else
                'only K is numeric
                ws.Range("a" & i).EntireRow.Interior.Color = vbGreen
            End If
        End If
    Next i
End Sub

[Numborero]

something like this:

Sub colorRows()
    Dim i As Long
    'Dim j As Long
    Dim lrK As Long     'last row with a filled cell in column K
    Dim lrM As Long     'last row with a filled cell in column M
    Dim lr As Long      'max of lrK and lrM
    Dim ws As Worksheet
    
    Set ws = ActiveSheet
    
    lrK = Range("k" & Rows.Count).End(xlUp).Row
    lrM = Range("m" & Rows.Count).End(xlUp).Row
    lr = Application.WorksheetFunction.Max(lrK, lrM)
    
    For i = 1 To lr     'my data starts in row 1, otherwise change this
        If IsNumeric(ws.Range("k" & i).Value) Then
            If IsNumeric(ws.Range("m" & i).Value) Then
                'both K and M have a numeric value, so BLUE
                ws.Range("a" & i).EntireRow.Interior.Color = vbBlue
            Else
                'only K is numeric
                ws.Range("a" & i).EntireRow.Interior.Color = vbGreen
            End If
        End If
    Next i
End Sub

Not sure why it wouldn't work. below the info in the collums it doesn't color any collums it doesn't seem to run.

Can I give you aditional info to work this out?

Collum K Collum L Colloum M

On Hand date First possible Delivery Date Delivered on
2013-09-05 14:10:00
2013-09-06 14:12:00 2013-09-10 08:52:00
2013-09-06 16:02:00 2013-09-10 08:52:00
2013-09-08 15:56:00 2013-09-10 08:52:00
2013-09-12 09:00:00

[vbfbryce]

I will look at that, but try stepping through it and see whether those columns have numeric values in them. Back shortly.

[vbfbryce]

If you're looking for dates in those columns, change to IsDate, like this:

Sub colorRows()
    Dim i As Long
    Dim lrK As Long     'last row with a filled cell in column K
    Dim lrM As Long     'last row with a filled cell in column M
    Dim lr As Long      'max of lrK and lrM
    Dim ws As Worksheet
    
    Set ws = ActiveSheet
    
    lrK = Range("k" & Rows.Count).End(xlUp).Row
    lrM = Range("m" & Rows.Count).End(xlUp).Row
    lr = Application.WorksheetFunction.Max(lrK, lrM)
    
    For i = 2 To lr     'my data starts in row 1, otherwise change this
        If IsDate(ws.Range("k" & i).Value) Then
            If IsDate(ws.Range("m" & i).Value) Then
                'both K and M have a date value, so BLUE
                ws.Range("a" & i).EntireRow.Interior.Color = vbBlue
            Else
                'only K is date
                ws.Range("a" & i).EntireRow.Interior.Color = vbGreen
            End If
        End If
    Next i

End Sub

In your example, they would all be green. None would be blue since there are no dates in column M.

[Numborero]

Thanks So much you cracked it!!!

[vbfbryce]

any time!

[Numborero]

Hi Bryce,

Good stuff this, one more question I've tried change the color of the green to light gray is that posible?
Or can I only use the VB colors. I also tried the excel ones but didn't work.

Ps this wont be my last question!!

[vbfbryce]

You can use a number of different colors. You can get the "color number" by manually changing the fill color of a cell, then accessing its value like:

Sub colNum()
    Dim myColorNumber As Long
    
    myColorNumber = Range("f9").Interior.Color  'F9 is the cell I changed
    MsgBox myColorNumber
End Sub

[Numborero]

Hi Bryce,

Nice one again!

Just found out that in excel 2010 it is possible to change for example:

Interior.Color = vbGreen

You can change the above for and create other colors aswell and then change these for the colors you prefer.


Interior.ColorIndex = 15

Interior.Color = RGB(255, 255, 255)

[Numborero]

Hello Bryce,

Don't now how to start a ne thread or if I need to.

This is how the code is now and need to ad on more thing. As an addition in this script I need borders on the rows wich are active. In this case it needs to start in the second row and until the last row wich contains data. I've had a look around but this is out of my league. Can you help? When you look at the pic below in needs to look like this..This is how the script is now:

Sub Bestio_Daily()

' runs macro for Bestio daily report

Application.ScreenUpdating = False
Dim i As Long
Dim lrK As Long 'last row with a filled cell in column K
Dim lrM As Long 'last row with a filled cell in column M
Dim lr As Long 'max of lrK and lrM
Dim ws As Worksheet

Set ws = ActiveSheet

lrK = Range("k" & Rows.Count).End(xlUp).Row
lrM = Range("m" & Rows.Count).End(xlUp).Row
lr = Application.WorksheetFunction.Max(lrK, lrM)

For i = 2 To lr 'my data starts in row 1, otherwise change this
If IsDate(ws.Range("k" & i).Value) Then
If IsDate(ws.Range("m" & i).Value) Then
'both K and M have a date value, so BLUE
ws.Range("a" & i).EntireRow.Interior.ColorIndex = 50
Else
'only K is date
ws.Range("a" & i).EntireRow.Interior.Color = RGB(192, 192, 192)
End If
End If
Next i

Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.RowHeight = 19.5
Columns("A:A").ColumnWidth = 19.57
Range("A1").Select
ActiveCell.FormulaR1C1 = "Bestio Daily Report for:"
Range("B1").Select
Columns("A:A").ColumnWidth = 23
Range("B1:C1").Select
ActiveCell.Value = Date

Range("B1:C1").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Range("B1:C1").Select
ActiveCell.Value = Date
Range("A1:C1").Select
Selection.Font.Bold = True




End Sub


Hope you could help?

[vbfbryce]

add something like this after you do the "coloring:"

With ws.Range("a2:m" & lr).BorderAround   'change M to whatever your last column is
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With

[Numborero]

Hello Bryce,

Thanks for the last code.

I want to start en new thread but don't know how.

I'm looking for a piece of code that wil scan a column and when it comes on a blank cell or empty cell it wil copy the cel on the right and pastes it in the blank cell and then continiues.

Hope you could help or let me know how to start a new post?

Kind regards,

Arne

[vbfbryce]

see screenshot

[Numborero]

Found it Thanks!

http://www.vbforums.com/showthread.p...the-blank-cell