ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Set a row colour when a criteria is met (https://www.excelbanter.com/excel-programming/369780-set-row-colour-when-criteria-met.html)

OldMike

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



All times are GMT +1. The time now is 03:33 PM.

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