Change format of cell based on value of cell in corresponding row?

[EssKayKay]

Hello,

I’m looking for a routine to change the status (format) of a cell in column I based on the status of a corresponding cell in the same row in column M for a range “M33:M2000” (or “I33:I2000”). I want the action to happen when the value of the cell in column M > 0. If the value of the cell in column M = 0 (or blank) then do nothing. Column M is actually formatted to Date. I would run this process via a command button.

Example: If the value in M44 is 06/12/23, then change the format of cell I44 to “Locked” and the font color to Black. Normally all cells in “I33:I2000” are unlocked & blue.

Thanks for viewing,
Steve K.

 

[awoohaw]

Just curious as to why you want to have this with a command button vs a persistent review? Are you going to go back and change the formatting (but keep the data the same) after you've reviewed the record? If not conditional formatting would be a consideration?

Nevermind, I did not see that you want to turn protection on.

But, you cannot have negative values formatted as dates. So you'll get an error in column M when that happens:
So, the all the dates except 12/31/1899 or (1/0/1990) will have your highlight.

Book1
	J			M
1	Value			Value as Date
2	-5			################
3	-3			################
4	4			1900-01-04
5	4			1900-01-04
6	5			1900-01-05
7	2			1900-01-02
8	1			1900-01-01
9	-1			################
10	-4			################
11	2			1900-01-02
12	-5			################
13	5			1900-01-05
14	4			1900-01-04
15	-1			################
16	0			1900-01-00
17	3			1900-01-03
18	2			1900-01-02
19	-3			################
20	-4			################
21	-3			################
22	5			1900-01-05
23	0			1900-01-00
24	-4			################
25	-5			################
26	-5			################
Sheet8

Cell Formulas
Range	Formula
J2:J26	J2	=M2#
M2:M26	M2	=RANDARRAY(25,1,-5,5,1)
Dynamic array formulas.

 

[EssKayKay]

I have another routine I received elsewhere that sort-of does what I want. The only problem is it does not do exactly what I want. It locks/unlocks the cells in column I in reverse (i.e., the ones I want locked are unlocked and the ones I want unlocked are locked. Also, I did not know how to change the color.

Here’s the code:

Private Sub cmdTest1_Click()
Dim myLastRow As Long
Dim i As Long
Application.ScreenUpdating = False

     myLastRow = Cells(Rows.Count, "M").End(xlUp).Row
     For i = 33 To myLastRow
     If Cells(i, "M").Value > 0 Then Range(Cells(i, "I"), Cells(i, "I")).Locked = False
     Next i

Application.ScreenUpdating = True
End Sub

 

[EssKayKay]

Just curious as to why you want to have this with a command button vs a persistent review? Are you going to go back and change the formatting (but keep the data the same) after you've reviewed the record? If not conditional formatting would be a consideration?

Nevermind, I did not see that you want to turn protection on.

But, you cannot have negative values formatted as dates. So you'll get an error in column M when that happens:
So, the all the dates except 12/31/1899 or (1/0/1990) will have your highlight.

Book1
	J			M
1	Value			Value as Date
2	-5			################
3	-3			################
4	4			1900-01-04
5	4			1900-01-04
6	5			1900-01-05
7	2			1900-01-02
8	1			1900-01-01
9	-1			################
10	-4			################
11	2			1900-01-02
12	-5			################
13	5			1900-01-05
14	4			1900-01-04
15	-1			################
16	0			1900-01-00
17	3			1900-01-03
18	2			1900-01-02
19	-3			################
20	-4			################
21	-3			################
22	5			1900-01-05
23	0			1900-01-00
24	-4			################
25	-5			################
26	-5			################
Sheet8

Cell Formulas
Range	Formula
J2:J26	J2	=M2#
M2:M26	M2	=RANDARRAY(25,1,-5,5,1)
Dynamic array formulas.

There will not be any negative dates in column M - only positive or blank cells.

 

[awoohaw]

So, really, it is if there is a date present, not if the number is greater than zero.

Regardless,
Here is some VBA with the color and locking assigned:
I am not the greatest at VBA, there may be more efficient formaulas. But this has the color and locking you seek, you can use those lines to acheive that in the VBA in the earlier posts:

NOTE: this starts in I2.

Sub ColorAndLockCells()
Dim ColI As Range
Dim ColIAddress As String
Dim CurSheetName As String

Application.ScreenUpdating = False
CurSheetName = ThisWorkbook.ActiveSheet.Index
Sheets(8).Select
Range("I2").Select
'Range.Font.Color = 0
ColIAddress = Range("I2").CurrentRegion.Offset(1, 0).Address
Set ColI = Range(ColIAddress)

For Each Cell In ColI
        If Cell.Offset(0, 4).Value > 0 Then
            Cell.Font.ColorIndex = 0
            Cell.Locked = True
        End If
    Next Cell
   
Application.ScreenUpdating = True
End Sub

 

[EssKayKay]

Thank you Awoohaw for your quick responses - much appreciated.
I tried your code. However, it errors with Compile error - Variable not defined on the line:
For Each cell In ColI

Not to press the subject but did you see my "old" code that sort of worked? Not sure if that makes any sense.

 

[awoohaw]

Updating your code with the formatting and locking you wish:

Private Sub cmdTest1_Click()
Dim myLastRow As Long
Dim i As Long
Application.ScreenUpdating = False
myLastRow = Cells(Rows.Count, "M").End(xlUp).Row
For i = 33 To myLastRow
If Cells(i, "M").Value > 0 Then [
Range(Cells(i, "I"), Cells(i, "I")).Locked = False
Range(Cells(i, "I"), Cells(i, "I")).Font.ColorIndex = 0
End if
Next i
Application.ScreenUpdating = True
End Sub

Regarding the code i suggested. Look at the sheet name/index. You need to be in a cell on the workbook you have the data in.
(It works for me, so it is referencing inside the code that is causing the problems.
Be sure the sheet name and the start of Column I is accurate).

 

[EssKayKay]

So, really, it is if there is a date present, not if the number is greater than zero.

Regardless,
Here is some VBA with the color and locking assigned:
I am not the greatest at VBA, there may be more efficient formaulas. But this has the color and locking you seek, you can use those lines to acheive that in the VBA in the earlier posts:

NOTE: this starts in I2.

Sub ColorAndLockCells()
Dim ColI As Range
Dim ColIAddress As String
Dim CurSheetName As String

Application.ScreenUpdating = False
CurSheetName = ThisWorkbook.ActiveSheet.Index
Sheets(8).Select
Range("I2").Select
'Range.Font.Color = 0
ColIAddress = Range("I2").CurrentRegion.Offset(1, 0).Address
Set ColI = Range(ColIAddress)

For Each Cell In ColI
        If Cell.Offset(0, 4).Value > 0 Then
            Cell.Font.ColorIndex = 0
            Cell.Locked = True
        End If
    Next Cell
 
Application.ScreenUpdating = True
End Sub

Thanks again Awoohaw.

I'm still getting an error. Maybe I'm missing something (which is totally possible). It may be something to do with CurSheetNam. I'm not sure about this.
Here's what I'm seeing.

 

[EssKayKay]

Updating your code with the formatting and locking you wish:

Private Sub cmdTest1_Click()
Dim myLastRow As Long
Dim i As Long
Application.ScreenUpdating = False
myLastRow = Cells(Rows.Count, "M").End(xlUp).Row
For i = 33 To myLastRow
If Cells(i, "M").Value > 0 Then [
Range(Cells(i, "I"), Cells(i, "I")).Locked = False
Range(Cells(i, "I"), Cells(i, "I")).Font.ColorIndex = 0
End if
Next i
Application.ScreenUpdating = True
End Sub

Regarding the code i suggested. Look at the sheet name/index. You need to be in a cell on the workbook you have the data in.
(It works for me, so it is referencing inside the code that is causing the problems.
Be sure the sheet name and the start of Column I is accurate).

One more issue Awoohaw,

Here's what I'm seeing when I run the revised Test routine. Again, I'm sure I'm probably missing something here.





Thank you once again,
Steve

 

[awoohaw]

I noticed one mistake I had (that worked for me). But, you didn't change any of the sheet and cell references as I had instructed:
use this:

Sub ColorAndLockCells()
Dim ColI As Range
Dim ColIAddress As String
Dim CurSheetName As String

Application.ScreenUpdating = False
CurSheetName = ThisWorkbook.ActiveSheet.Name
Sheets(CurSheetName).Select
Range("I2").Select
'Range.Font.Color = 0
ColIAddress = Range("I2").CurrentRegion.Offset(1, 0).Address
Set ColI = Range(ColIAddress)

For Each Cell In ColI
        If Cell.Offset(0, 4).Value > 0 Then
            Cell.Font.ColorIndex = 0
            Cell.Locked = True
        End If
    Next Cell
    
Application.ScreenUpdating = True
End Sub

these lines all need to be changed to fit your worksheet/workbook:

Range("I2").Select
'Range.Font.Color = 0
ColIAddress = Range("I2").CurrentRegion.Offset(1, 0).Address