aumentar el numero de formato condicional

Enviado


Saludos.

Martin

!Hombreee! no se habia ocurrido q iba a ser para la misma hoja. Habra
q meter los dos codigos dentro del mismo evento (copiando un macro
bajo el otro no funcionara). Y ademas usan los mismos nombres de
variables por lo cual creo q habria q separar los dos codigos como dos
sub-procedimientos independientes y llamarlos desde el procedimiento
prinipal

Private Sub Worksheet_Change(ByVal Target As Range)
End Sub

Por que no me envias tu hoja y te hago el hibrido - creo q sera mas
facil. Mi correo electronico es
(quitando NOSPAM y PLEASE)

Saludos,
KL

martin,

Prueba sustituir todo el codigo con lo siguiente.

Saludos,
KL

'--Inicio Codigo
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rango As Range
Dim UFila As Long
Dim UCol As Integer

With Target.Parent
UCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
UFila = .Cells(.Rows.Count, 1).End(xlUp).Row
Set Rango = .Range(Cells(1, 1), Cells(UFila, UCol))
End With
If Not Rango Is Nothing Then
Application.ScreenUpdating = False
Application.EnableEvents = False
Call ActualizarGraficos(Rango)
Call FormatoCondicional(Rango)
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub

Private Sub ActualizarGraficos(rng As Range)
Dim nGrfs As Integer
If Charts.Count < rng.Columns.Count - 1 Then
nGrfs = Charts.Count
Else
nGrfs = rng.Columns.Count - 1
End If
For i = 1 To nGrfs
With Charts(i).SeriesCollection(1)
.XValues = rng.Columns(1)
.Values = rng.Columns(1 + i)
.Name = rng.Columns(1 + i).Cells(1, 1)
End With
Next i
End Sub

Private Sub FormatoCondicional(rng As Range)
Dim c As Range
With rng
Set rng = .Resize(.Rows.Count - 1, _
.Columns.Count - 1).Offset(1, 1)
.Interior.ColorIndex = xlNone 'transparente
.Font.ColorIndex = 0
End With

If rng Is Nothing Then Exit Sub
For Each c In rng
With c
If IsNumeric(c) And Not IsEmpty(c) Then
Select Case c
Case Is < 201
.Interior.ColorIndex = 3 'rojo
.Interior.Pattern = xlSolid
.Font.ColorIndex = 2
Case 201 To 350
.Interior.ColorIndex = 6 'amarillo
.Interior.Pattern = xlSolid
Case 351 To 500
.Interior.ColorIndex = 4 'verde
.Interior.Pattern = xlSolid
Case Is > 500
.Interior.ColorIndex = 5 'azul
.Interior.Pattern = xlSolid
.Font.ColorIndex = 2
Case Else
End Select
Else
.Interior.ColorIndex = xlNone
End If
End With
Next
End Sub
'--Fin Codigo


"martin" wrote in message
news:

Enviado


Saludos.

Martin

!Hombreee! no se habia ocurrido q iba a ser para la misma hoja. Habra
q meter los dos codigos dentro del mismo evento (copiando un macro
bajo el otro no funcionara). Y ademas usan los mismos nombres de
variables por lo cual creo q habria q separar los dos codigos como dos
sub-procedimientos independientes y llamarlos desde el procedimiento
prinipal

Private Sub Worksheet_Change(ByVal Target As Range)
End Sub

Por que no me envias tu hoja y te hago el hibrido - creo q sera mas
facil. Mi correo electronico es
(quitando NOSPAM y PLEASE)

Saludos,
KL

Muchisimas gracias KL, es perfecto.



Saludos


Martin

martin,

Prueba sustituir todo el codigo con lo siguiente.

Saludos,
KL

'--Inicio Codigo
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rango As Range
Dim UFila As Long
Dim UCol As Integer

With Target.Parent
UCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
UFila = .Cells(.Rows.Count, 1).End(xlUp).Row
Set Rango = .Range(Cells(1, 1), Cells(UFila, UCol))
End With