Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Set a row colour when a criteria is met
Hi
I am trying (and giving myself a severe headache in the process), to write a script that will run under workbook_open and check all times in column "A1" of a four column worksheet. The script will check if the result of the sum Now() - Oldtime is greater than 12. If it is I want to reset the row colour (excuse english spelling ;- ) to black and then move to the next row A3. The columns are formatted thus; Col A is formatted to time Col B is formatted to date Col C is a number Col D is text As you can see, the page is protected on entry (Cols A, B & C are locked) and is unlocked to allow the calculations to be carried out before re-locking and making available to the user. The user can only edit col D and when they do I want to open a message box asking if they want the row highlighted. If they answer yes then the protection is removed, the Cols A & B are updated with the current Date and time, the row is set to red and the protection is replaced The script to update the record and set the date and time works, except for the message bit and setting the colour which I haven't tried yet Private Sub Worksheet_Change(ByVal Target As Range) ActiveSheet.Unprotect "xxxx" Application.EnableEvents = False Cells(Target.Row, 1).Value = Now Cells(Target.Row, 2).Value = Now Application.EnableEvents = True ActiveSheet.Protect "xxxx" End Sub Private Sub Workbook_Open() ActiveSheet.Unprotect "xxxxxx" Application.EnableEvents = False I have had a couple of stabs at writing the second script by referencing similar script in a book I have but alas, with little success Dim Oldtime As Date Dim c As Range Dim lstRng As Range Set lstRng = Range("A1", Range("A100").End(xlUp)) 'get the list of data For Each c In lstRng Oldtime = c.Value If (Now() - Oldtime) < 12 Then Application.EnableEvents = True ActiveSheet.Protect "xxxx" End Sub and Public Sub clear_Page(ByVal Target As Range) Dim RowDate As Date Dim RowTime As Date Dim RowCount As Integer Dim CountPosition Row_Date = " " Row_Time = " " Row_Count = "0" CountPosition = "2" ActiveSheet.Unprotect "Rave" Application.EnableEvents = False Application.Goto reference: Worksheets(Sheet1).Range (B2) For Each c In Worksheets("Sheet1").Range("A1:A100") If (Now() - c.Value) < 12 Then Application.Goto reference: Worksheets(Sheet1).Range ("E(CountPosition)") Worksheets("Sheet1").Range("E(Countposition)").Fon t.Color = "Black" c.Value = 0 CountPosition = CountPosition + 1 Else c.Value = 0 CountPosition = CountPosition + 1 End If Next c End Sub If anyone out there likes a challenge and can help I would be grateful Regards Mike |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
SUMIF formula where the colour of the cell is the criteria | Excel Worksheet Functions | |||
Change Row Colour if certain criteria is met | Excel Worksheet Functions | |||
Count by Colour (Text) with other criteria | Excel Discussion (Misc queries) | |||
Count by Colour (Text) with other criteria | Excel Discussion (Misc queries) | |||
copy/paste based on colour criteria | Excel Programming |