color row using macro..

[marc747]

Hi,
Is there any way to use a macro to find a word example "Total" in a
column example "C:C" and when it finds the word it will color that row
say "Blue" and then find next and if find more do the same all the way
to the end of the column.

Thanks

 

[Mike H]

Hi,

Right click your sheet tab, view code and paste this in and run it

Sub marine()
Dim myrange, MyRange1 As Range
lastrow = Cells(Rows.Count, "C").End(xlUp).Row
Set myrange = Range("C1:C" & lastrow)
For Each c In myrange
If UCase(c.Value) = "TOTAL" Then
If MyRange1 Is Nothing Then
Set MyRange1 = c.EntireRow
Else
Set MyRange1 = Union(MyRange1, c.EntireRow)
End If
End If
Next
MyRange1.Interior.ColorIndex = 41
End Sub

Mike

 

[Don Guillett]

try this. change sheet25 to suit the name of your sheet and 500 to suit your
last row

Sub colortotalrow()
With Worksheets("sheet25").Range("c1:c500")
Set c = .Find("Total", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Rows(c.Row).Interior.ColorIndex = 6
Set c = .FindNext(c)
Loop While Not c Is Nothing _
And c.Address <> firstAddress
End If
End With

End Sub

 

[marc747]

try this. change sheet25 to suit the name of your sheet and 500 to suit your
last row

Sub colortotalrow()
With Worksheets("sheet25").Range("c1:c500")
    Set c = .Find("Total", LookIn:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
         Rows(c.Row).Interior.ColorIndex = 6
        Set c = .FindNext(c)
        Loop While Not c Is Nothing _
        And c.Address <> firstAddress
    End If
End With

End Sub

--
Don Guillett
Microsoft MVP Excel
SalesAid Software






- Show quoted text -

Hi,
Thanks it works great. Can I make another macro or add to this one,
I need the macro to first find the "Total" in "C:C" then clear the
Borders in that ROW and then place a border on top and bottom of that
ROW and if any cell in that ROW is not empty place a OUTLINE Border.
Thanks

 

[Don Guillett]

Please TOP post with me

Sub colortotalrow()
With Worksheets("sheet25").Range("c1:c500")
Set c = .Find("Total", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
With Rows(c.Row)
.Interior.ColorIndex = 6
.BorderAround , Weight:=xlMedium
End With
Set c = .FindNext(c)
Loop While Not c Is Nothing _
And c.Address <> firstAddress
End If
End With

End Sub

--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)

try this. change sheet25 to suit the name of your sheet and 500 to suit
your
last row

Sub colortotalrow()
With Worksheets("sheet25").Range("c1:c500")
Set c = .Find("Total", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
Rows(c.Row).Interior.ColorIndex = 6
Set c = .FindNext(c)
Loop While Not c Is Nothing _
And c.Address <> firstAddress
End If
End With

End Sub

--
Don Guillett
Microsoft MVP Excel
SalesAid Software






- Show quoted text -

Hi,
Thanks it works great. Can I make another macro or add to this one,
I need the macro to first find the "Total" in "C:C" then clear the
Borders in that ROW and then place a border on top and bottom of that
ROW and if any cell in that ROW is not empty place a OUTLINE Border.
Thanks

 

[marc747]

Hi,
Thanks it works great. Can I make another macro or add to this one,
I need the macro to first find the "Total" in "C:C" then clear the
Borders in that ROW and then place a border on top and bottom of that
ROW and if any cell in that ROW is not empty place a OUTLINE Border.
Thanks

 

[Don Guillett]

Did you NOT see my last post with the change and the request to TOP POST


--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)






Hi,
Thanks it works great. Can I make another macro or add to this one,
I need the macro to first find the "Total" in "C:C" then clear the
Borders in that ROW and then place a border on top and bottom of that
ROW and if any cell in that ROW is not empty place a OUTLINE Border.
Thanks

 

[marc747]

Did you NOT see my last post with the change and the request to TOP POST

--
Don Guillett
Microsoft MVP Excel
SalesAid Software



Hi,
Thanks it works great. Can I make another macro or add to this one,
I need the macro to first find the "Total" in "C:C" then clear the
Borders in that ROW and then place a border on top and bottom of that
ROW and if any cell in that ROW is not empty place a OUTLINE Border.
Thanks- Hide quoted text -

- Show quoted text -

Hi,
What is a top post?

 

[marc747]

Did you NOT see my last post with the change and the request to TOP POST

--
Don Guillett
Microsoft MVP Excel
SalesAid Software



Hi,
Thanks it works great. Can I make another macro or add to this one,
I need the macro to first find the "Total" in "C:C" then clear the
Borders in that ROW and then place a border on top and bottom of that
ROW and if any cell in that ROW is not empty place a OUTLINE Border.
Thanks- Hide quoted text -

- Show quoted text -

Yes, I see know. Thanks.

 

[marc747]

Yes, I see know. Thanks.- Hide quoted text -

- Show quoted text -

Hi,
Thanks, How about if any cell in that ROW that we colored that is not
empty place a OUTLINE Border, not only the top and bottom but the
sides too for those cells.
Thanks

 

[Rick Rothstein \(MVP - VB\)]

Top post is when you do NOT keep putting your new messages at the bottom of
the old messages like you have been doing; rather, it is where you put you
message at the top of stack of previous messages like this response from me
did to your question (previous message). The reason volunteers like top
posting is they don't have to scroll down a "mile's worth" of previous
messages just to find the new message you have added. If you top post, then
your message is right on top... easy to find and easy to respond to.

Rick

 

[marc747]

Thanks!

Top post is when you do NOT keep putting your new messages at the bottom of
the old messages like you have been doing; rather, it is where you put you
message at the top of stack of previous messages like this response from me
did to your question (previous message). The reason volunteers like top
posting is they don't have to scroll down a "mile's worth" of previous
messages just to find the new message you have added. If you top post, then
your message is right on top... easy to find and easy to respond to.

Rick




- Show quoted text -

 

[marc747]

Hi,
Thanks, Now I got the Top Post!
How about if any cell in that ROW that we colored that is not empty
place a OUTLINE Border, not only the top and bottom but the sides too
for those cells that are not empty.
Thanks.

 

[Don Guillett]

What you want can be done. Let's see now
we have an empty cell
to the right we have a full cell
to the right we have an empty cell
so now all cells have a right and left border also.
Tell us how to NOT have a border on the empty cell in the middle.

You did not mention your layout or how many cells per row may be involved.
If desired, send me a workbook to my address below and I'll have a look.

--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)
Hi,
Thanks, Now I got the Top Post!
How about if any cell in that ROW that we colored that is not empty
place a OUTLINE Border, not only the top and bottom but the sides too
for those cells that are not empty.
Thanks.

 

[Don Guillett]

I sent this
Sub ColorTotalRow()
Application.ScreenUpdating = False
With Worksheets("sheet26")

With Cells.SpecialCells(xlCellTypeLastCell)
lc = .Column
lr = .Row
End With


With .Rows("2:" & lr)
..Font.Bold = False
..Borders.LineStyle = xlNone
..Interior.ColorIndex = xlNone
End With

With .Range("c2:c" & lr)
Set c = .Find("Total", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
With Range(Cells(c.Row, 1), Cells(c.Row, lc))
.Font.Bold = True
.Interior.ColorIndex = 6
.BorderAround , Weight:=xlMedium

End With

For Each cc In Range(Cells(c.Row, 1), Cells(c.Row, lc))
If Len(Application.Trim(cc)) > 0 Then
cc.Borders.LineStyle = xlContinuous
cc.Borders.Weight = xlMedium
End If
Next cc

Set c = .FindNext(c)
Loop While Not c Is Nothing _
And c.Address <> firstAddress
End If
End With

End With
Application.ScreenUpdating = True
End Sub

 

[marc747]

Thanks, It is Great!

I sent this
Sub ColorTotalRow()
Application.ScreenUpdating = False
With Worksheets("sheet26")

With Cells.SpecialCells(xlCellTypeLastCell)
lc = .Column
lr = .Row
End With

With .Rows("2:" & lr)
.Font.Bold = False
.Borders.LineStyle = xlNone
.Interior.ColorIndex = xlNone
End With

With .Range("c2:c" & lr)
    Set c = .Find("Total", LookIn:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
      Do
        With Range(Cells(c.Row, 1), Cells(c.Row, lc))
          .Font.Bold = True
          .Interior.ColorIndex = 6
          .BorderAround , Weight:=xlMedium

        End With

      For Each cc In Range(Cells(c.Row, 1), Cells(c.Row, lc))
       If Len(Application.Trim(cc)) > 0 Then
        cc.Borders.LineStyle = xlContinuous
        cc.Borders.Weight = xlMedium
       End If
      Next cc

      Set c = .FindNext(c)
      Loop While Not c Is Nothing _
      And c.Address <> firstAddress
    End If
End With

End With
Application.ScreenUpdating = True
End Sub

--
Don Guillett
Microsoft MVP Excel
SalesAid Software








- Show quoted text -

 

[Don Guillett]

glad to help

--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)
Thanks, It is Great!

 

[marc747]

Hi,
Something else came up, hope you can help!
Can we add a line to say that when it finds the "Total" also insert a
ROW below that Row
Thanks

 

[Don Guillett]

Just add another line below the DO
' Do

Rows(c.row + 1).Insert

--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)
Hi,
Something else came up, hope you can help!
Can we add a line to say that when it finds the "Total" also insert a
ROW below that Row
Thanks

 

[marc747]

Hi, Thanks.
How can I make the statement below to only do the Borders to cells
that are not empty, cells that have no values should not have borders.

cc.Borders.LineStyle = xlContinuous

Thanks.