ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Find Heading & Apply Formula (https://www.excelbanter.com/excel-programming/370258-find-heading-apply-formula.html)

itchock

Find Heading & Apply Formula
 

-----------------------------------------------------------------------
A poll associated with this post was created, to vote and see th
results, please visit http://www.excelforum.com/showthread.php?threadid=57126
-----------------------------------------------------------------------
Question: Is this post good & make some sense or useful for other

- Goo
- Very Usefu
- Usefu
- Not Usefu
-----------------------------------------------------------------------

Hi,

In the attached excel sheet you can find 2 subheadings named Safet
and Waiting. Like this i have many sub headings in my excel sheets
Each sub heading contains some rows.

The below is the code i used to change the Font color based on th
date values.

Every thing works fine. My requirement is if any rows added unde
subheading "Safety" then i want to run the loop from 1 st row to las
row under this subheading which will change the color based on th
given date.

How to identify under which subheading the row is added and which i
first row and which is last row.


Code
-------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call CycleThrough
End Sub

Sub CycleThrough()
Dim Counter As Integer
If ActiveCell.Column = 3 And ActiveCell.Row = 1 And ActiveCell.Row <= 6 Then
For Counter = 1 To 6
If IsDate(Worksheets("Sheet2").Cells(Counter, 3).Value) = True Then
If Date - Worksheets("Sheet2").Cells(Counter, 3).Value = 100 Then
Worksheets("Sheet2").Cells(Counter, 3).Font.Color = 255
ElseIf (Date - Worksheets("Sheet2").Cells(Counter, 3).Value = 70) And (Date - Worksheets("Sheet2").Cells(Counter, 3).Value <= 100) Then
Worksheets("Sheet2").Cells(Counter, 3).Font.Color = 82400
ElseIf Date - Worksheets("Sheet2").Cells(Counter, 3).Value < 70 Then
Worksheets("Sheet2").Cells(Counter, 3).Font.Color = 25350
End If
End If
Next
End If
End Su
-------------------



Kindly help me to solve this.

Thanks,
Chock.:

+-------------------------------------------------------------------
|Filename: Book2.zip
|Download: http://www.excelforum.com/attachment.php?postid=5188
+-------------------------------------------------------------------

--
itchoc
-----------------------------------------------------------------------
itchock's Profile: http://www.excelforum.com/member.php...fo&userid=3021
View this thread: http://www.excelforum.com/showthread.php?threadid=57126



All times are GMT +1. The time now is 10:41 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com