Private Sub Worksheet_Change(ByVal Target As Range)
Const colorOdd As Long = vbBlack
Const colorEven As Long = vbBlue
Static N As Long
If IsEmpty(Range("H1")) Or Target.Address <> Range("H1").Address Then Exit Sub
N = N + 1
With Range("F5:I5")
If N Mod 2 <> 0 Then
With .Font
.Bold = False
.Color = colorOdd
End With
Else
With .Font
.Bold = True
.Color = colorEven
End With
End If
End With
End Sub
Livro1.xlsx | |||||||||
---|---|---|---|---|---|---|---|---|---|
E | F | G | H | I | J | K | |||
2 | |||||||||
3 | |||||||||
4 | N.º ITEM | PRODUT | QUANTITY | PVP | |||||
5 | 235 | TV | 5 | 5 € | |||||
6 | |||||||||
7 | |||||||||
8 | |||||||||
9 | |||||||||
Folha3 |
Excellet @JoeMo ????Assuming my understanding in post #10 of what you want is correct, try this:
VBA Code:Private Sub Worksheet_Change(ByVal Target As Range) Const colorOdd As Long = vbBlack Const colorEven As Long = vbBlue Static N As Long If IsEmpty(Range("H1")) Or Target.Address <> Range("H1").Address Then Exit Sub N = N + 1 With Range("F5:I5") If N Mod 2 <> 0 Then With .Font .Bold = False .Color = colorOdd End With Else With .Font .Bold = True .Color = colorEven End With End If End With End Sub
Livro1.xlsm | |||||||||
---|---|---|---|---|---|---|---|---|---|
E | F | G | H | I | J | K | |||
3 | |||||||||
4 | N.º ITEM | PRODUT | QUANTITY | PVP | |||||
5 | 235 | TV | 2 | 5 € | |||||
6 | 400 | APPLE | 2 | 10 € | |||||
7 | 605 | MAC | 1 | 56 € | |||||
8 | 896 | CUP | 5 | 2 € | |||||
9 | 532 | RICE | 6 | 4 € | |||||
10 | |||||||||
11 | |||||||||
Folha3 |
You are welcome. Regarding your new request, don't know what you mean by "extended" range. Please provide more information.Excellet @JoeMo ????
Works beatifull.
To finish would like to applied your vba code in a extended range like:
Livro1.xlsm
E F G H I J K 3 4 N.º ITEM PRODUT QUANTITY PVP 5 235 TV 2 5 € 6 400 APPLE 2 10 € 7 605 MAC 1 56 € 8 896 CUP 5 2 € 9 532 RICE 6 4 € 10 11 Folha3
Thank you very much @JoeMo.??
Big @JoeMoYou are welcome. Regarding your new request, don't know what you mean by "extended" range. Please provide more information.
Livro1.xlsm | |||||||||
---|---|---|---|---|---|---|---|---|---|
E | F | G | H | I | J | K | |||
3 | |||||||||
4 | N.º ITEM | PRODUT | QUANTITY | PVP | |||||
5 | 235 | TV | 2 | 5 € | |||||
6 | 400 | APPLE | 3 | 10 € | |||||
7 | 605 | MAC | 1 | 56 € | |||||
8 | 896 | CUP | 9 | 2 € | |||||
9 | 532 | RICE | 6 | 4 € | |||||
10 | |||||||||
11 | |||||||||
Folha3 |
Private Sub Worksheet_Change(ByVal Target As Range)
Const colorOdd As Long = vbBlack
Const colorEven As Long = vbBlue
Static N() As Long
Dim R As Range, c As Range 'R will be the range you want to monitor for changes
Set R = Range("H5:H9")
ReDim Preserve N(1 To R.Rows.Count)
If Not Intersect(Target, R) Is Nothing Then
For Each c In Intersect(Target, R)
N(c.Row - R(1).Row + 1) = N(c.Row - R(1).Row + 1) + 1
With Range("F" & c.Row, "I" & c.Row)
If N(c.Row - R(1).Row + 1) Mod 2 <> 0 Then
With .Font
.Bold = False
.Color = colorOdd
End With
Else
With .Font
.Bold = True
.Color = colorEven
End With
End If
End With
Next c
End If
End Sub
Big @JoeMoTry this:
VBA Code:Private Sub Worksheet_Change(ByVal Target As Range) Const colorOdd As Long = vbBlack Const colorEven As Long = vbBlue Static N() As Long Dim R As Range, c As Range 'R will be the range you want to monitor for changes Set R = Range("H5:H9") ReDim Preserve N(1 To R.Rows.Count) If Not Intersect(Target, R) Is Nothing Then For Each c In Intersect(Target, R) N(c.Row - R(1).Row + 1) = N(c.Row - R(1).Row + 1) + 1 With Range("F" & c.Row, "I" & c.Row) If N(c.Row - R(1).Row + 1) Mod 2 <> 0 Then With .Font .Bold = False .Color = colorOdd End With Else With .Font .Bold = True .Color = colorEven End With End If End With Next c End If End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Const colorOdd As Long = vbBlue
Const colorEven As Long = vbBlack
Static N() As Long
Dim R As Range, c As Range 'R will be the range you want to monitor for changes
Set R = Range("H5:H9")
ReDim Preserve N(1 To R.Rows.Count)
If Not Intersect(Target, R) Is Nothing Then
For Each c In Intersect(Target, R)
N(c.Row - R(1).Row + 1) = N(c.Row - R(1).Row + 1) + 1
With Range("F" & c.Row, "I" & c.Row)
If N(c.Row - R(1).Row + 1) Mod 2 = 0 Then
With .Font
.Bold = True
.Color = colorOdd
End With
Else
With .Font
.Bold = False
.Color = colorEven
End With
End If
End With
Next c
End If
End Sub
Private Sub Workbook_Open()
With Me.Sheets("Sheet1") 'adjust sheet name to suit
With .Range("F5:I9").Font 'adjust range to suit
.Color = vbBlack
.Bold = False
End With
End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Const colorOdd As Long = vbBlue
Const colorEven As Long = vbBlack
Static N() As Long
Dim R As Range, c As Range 'R will be the range you want to monitor for changes
Set R = Range("H5:H9")
ReDim Preserve N(1 To R.Rows.Count)
If Not Intersect(Target, R) Is Nothing Then
For Each c In Intersect(Target, R)
N(c.Row - R(1).Row + 1) = N(c.Row - R(1).Row + 1) + 1
With Range("F" & c.Row, "I" & c.Row)
If N(c.Row - R(1).Row + 1) Mod 2 = 0 Then
With .Font
.Bold = False
.Color = colorEven
End With
Else
With .Font
.Bold = True
.Color = colorOdd
End With
End If
End With
Next c
End If
End Sub
Brilliant @JoeMo !!! ??I modified the code in post #18 slightly and think it should be coupled with a workbook_open event to set everything in the target range to non-bold, black font when the workbook is opened.
This code goes in a ThisWorkbook module:
and this code in the worksheet as before:VBA Code:Private Sub Workbook_Open() With Me.Sheets("Sheet1") 'adjust sheet name to suit With .Range("F5:I9").Font 'adjust range to suit .Color = vbBlack .Bold = False End With End With End Sub
VBA Code:Private Sub Worksheet_Change(ByVal Target As Range) Const colorOdd As Long = vbBlue Const colorEven As Long = vbBlack Static N() As Long Dim R As Range, c As Range 'R will be the range you want to monitor for changes Set R = Range("H5:H9") ReDim Preserve N(1 To R.Rows.Count) If Not Intersect(Target, R) Is Nothing Then For Each c In Intersect(Target, R) N(c.Row - R(1).Row + 1) = N(c.Row - R(1).Row + 1) + 1 With Range("F" & c.Row, "I" & c.Row) If N(c.Row - R(1).Row + 1) Mod 2 = 0 Then With .Font .Bold = False .Color = colorEven End With Else With .Font .Bold = True .Color = colorOdd End With End If End With Next c End If End Sub