Para DAM y Elsa ... Para una macro que actualmente me resalta ciertas filas con un color
Hola a Todos ...... DAM, Elsa y muchos mas!!
Si tengo la siguiente MACRO llamada colorearfila1
Sub colorearfila1()
Worksheets("AGENDA").Select
Application.ScreenUpdating = False
Range("B2:Q20000").Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
fin = Range("f" & Rows.Count).End(xlUp).Row 'última fila con datos de la columna F
For i = 2 To fin
Select Case Range("F" & i)
Case "27925679": Range("A" & i & ":Q" & i).Interior.ColorIndex = 4
Case "27900215": Range("A" & i & ":Q" & i).Interior.ColorIndex = 4
Case "1098685641": Range("A" & i & ":Q" & i).Interior.ColorIndex = 4
Case "27903445": Range("A" & i & ":Q" & i).Interior.ColorIndex = 4
Case "63540577": Range("A" & i & ":Q" & i).Interior.ColorIndex = 1
Case "63540577": Range("A" & i & ":Q" & i).font.ColorIndex = 2
End Select
Select Case Range("G" & i)
Case "PACIENTES AVANZAR ": Range("A" & i & ":Q" & i).Interior.ColorIndex = 4
Case "NATHALIA ISABEL ANAYA ORTIZ": Range("A" & i & ":Q" & i).Interior.ColorIndex = 6
End Select
Next
For i = 2 To Range("N" & Rows.Count).End(xlUp).Row
If InStr(1, UCase(Range("N" & i)), "BOTOX") > 0 Then
Range("A" & i & ":Q" & i).Interior.ColorIndex = 7
End If
If InStr(1, UCase(Range("N" & i)), "PLASMA") > 0 Then
Range("A" & i & ":Q" & i).Interior.ColorIndex = 3
End If
If InStr(1, UCase(Range("N" & i)), "RELLENO") > 0 Then
Range("A" & i & ":Q" & i).Interior.ColorIndex = 7
End If
If InStr(1, UCase(Range("N" & i)), "CRIO") > 0 Then
Range("A" & i & ":Q" & i).Interior.ColorIndex = 7
End If
If InStr(1, UCase(Range("N" & i)), "RESECCIÓN") > 0 Then
Range("A" & i & ":Q" & i).Interior.ColorIndex = 3
End If
If InStr(1, UCase(Range("G" & i)), "VISITADOR") > 0 Then
Range("A" & i & ":Q" & i).Interior.ColorIndex = 1
End If
If InStr(1, UCase(Range("G" & i)), "VISITADOR") > 0 Then
Range("A" & i & ":Q" & i).font.ColorIndex = 2
End If
Next
Worksheets("INGRESAR_CITA").Select
End Sub
Hasta ahí todo super bien.
Pero resulta que cada vez que hay una persona que no puede subir escaleras, necesito primero meterme a la macro colorearfilas1, ingresar manualmente una nueva instrucción como este ejemplo:
Case "27900215": Range("A" & i & ":Q" & i).Interior.ColorIndex = 4
Y ahi si salirme de la macro e ingresar el paciente.
Que posibilidad hay que cuando esos casos sucedan, de alguna manera se pudiera ingresar el nuevo ID de la personas que hay que colorear la fila sin necesidad de ingresar a la macro y hacerlo todo manualmente?
1 Respuesta
Te anexo la macro
Sub colorearfila1()
'Por.Dante Amor
Application.ScreenUpdating = False
Set h1 = Worksheets("AGENDA")
Set h2 = Worksheets("IDP")
Set h3 = Worksheets("INGRESAR_CITA")
'
With h1.Range("B2:Q20000").Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
'
For i = 2 To h1.Range("F" & Rows.Count).End(xlUp).Row
Set b = h2.Range("A:A").Find(h1.Cells(i, "F"), lookat:=xlWhole)
If Not b Is Nothing Then
f = b.Row
n = h2.Cells(b.Row, "B")
h1.Range("A" & i & ":Q" & i).Interior.ColorIndex = h2.Cells(b.Row, "B")
End If
'
Select Case h1.Range("G" & i)
Case "PACIENTES AVANZAR ": h1.Range("A" & i & ":Q" & i).Interior.ColorIndex = 4
Case "NATHALIA ISABEL ANAYA ORTIZ": h1.Range("A" & i & ":Q" & i).Interior.ColorIndex = 6
End Select
'
If InStr(1, UCase(h1.Range("N" & i)), "BOTOX") > 0 Then
h1.Range("A" & i & ":Q" & i).Interior.ColorIndex = 7
End If
If InStr(1, UCase(h1.Range("N" & i)), "PLASMA") > 0 Then
h1.Range("A" & i & ":Q" & i).Interior.ColorIndex = 3
End If
If InStr(1, UCase(h1.Range("N" & i)), "RELLENO") > 0 Then
h1.Range("A" & i & ":Q" & i).Interior.ColorIndex = 7
End If
If InStr(1, UCase(h1.Range("N" & i)), "CRIO") > 0 Then
h1.Range("A" & i & ":Q" & i).Interior.ColorIndex = 7
End If
If InStr(1, UCase(h1.Range("N" & i)), "RESECCIÓN") > 0 Then
h1.Range("A" & i & ":Q" & i).Interior.ColorIndex = 3
End If
If InStr(1, UCase(h1.Range("G" & i)), "VISITADOR") > 0 Then
h1.Range("A" & i & ":Q" & i).Interior.ColorIndex = 1
End If
If InStr(1, UCase(h1.Range("G" & i)), "VISITADOR") > 0 Then
h1.Range("A" & i & ":Q" & i).Font.ColorIndex = 2
End If
Next
'
h3.Select
End SubTienes que crear una hoja llamada "IDP" con la siguiente información:
En la columna A pones el ID del paciente y en la columna B pones el número de color que le corresponde. Lo demás lo hace la macro.
Saludos. Dante Amor
Recuerda valorar la respuesta
