Color de celda cambiante con el mismo contenido

En la misma Hoja tengo una base de datos ( Buscar V) donde en unas determinadas celdas aparecen las provincias según la comunidad autónoma que has seleccionado en "B4"
En la columna "B" tengo validación a dichas celdas por lo que me aparece un desplegable con las provincias según la comunidad autónoma seleccionada en "B4", hasta aquí todo bien.
Necesito adjudicarle a cada provincia un color de fondo en las celdas de la columna "B", pero con la particularidad de poder cambiarlo cuantas veces necesite y que si en un desplegable de una celda de la columna "B" selecciono una provincia me aporte también el color,
no se si tengo que poner celdas con el nombre de la provincia y el color en una misma celda o en celdas distintas,
tengo: Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Asigna color segun provincia insertada en Hoja Datos
Set Relcell = Range("B7:B28")
If Not Application.Intersect(Relcell, Range(Target.Address(False, False))) Is Nothing Then
Application.EnableEvents = False
Select Case UCase(Trim(Target.Value))
Case "ÁLAVA"
Target.Interior.ColorIndex = RGB(80, 237, 194)
La idea es que el color en vez de decirle el color que es, decirle que lo copie de una celda determinada, por ejemplo en H2 tengo Alicante con fondo amarillo, o en H2 tengo Alicante y en I2 tengo la celda sin valor y con fondo amarillo
Un saludo y gracias de antemano

1 respuesta

Respuesta
1
Te dejo la rutina ajustada, no necesitas el Select Case si lo único que se intenta es darle un color.
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Asigna color segun provincia insertada en Hoja Datos
Set Relcell = Range("B7:B28")
If Not Application.Intersect(Relcell, Range(Target.Address(False, False))) Is Nothing Then
dato = Target.Value
Set busco = ActiveSheet.Range("H2:H50").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not busco Is Nothing Then
Target.Interior.ColorIndex = busco.Offset(0, 1).Interior.ColorIndex
End If
Set busco = Nothing
End If
Set Relcell = Nothing
End Sub
Aquí construí una lista de valores posibles en col H y los colores en col I, pero si los colores estarán en la misma col H, quítale el Offset que te marqué con negrita.
Por eso no necesito del Select. Al ingresar un valor en tu rango, se busca en esa col H el target, es decir el valor que ha tomado la celda con la selección del desplegable. Si lo encuentra, busca el color.
Esto así te sirve para cualquier valor, sin necesidad de evaluar 1 x 1.
PD) Ya te envié 2 respuestas. No olvides finalizarlas si el tema quedó comprendido y solucionado.
Me funciona bien, el error viene cuando selecciono varias celdas de la columna b para borrar el contenido que me sale un error, en cambio si las boro de una en una va bien, ¿qué tendría que añadirle para que al seleccionar varias celdas de la misma columna b y darle al supr para borrar el contenido me las borre?
Te dejo las 3 primeras líneas, donde verás en negrita la que tenés que agregar:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Asigna color segun provincia insertada en Hoja Datos
If Target.Count > 1 Then Exit Sub
'y aquí sigue el resto
Sdos
Lo he puesto y me deja el color de la provincia anterior, me pasa que si pongo una provincia por ejemplo en B9 me colorea la celda perfectamente, si selecciono la celda B9y borro, se me borra el nombre de la provincia pero me deja el color, necesito que me respete el color original de la celda, es decir si tengo una celda en color rojo, pongo una provincia y me lo cambia al color de la provincia, que luego al borrar la provincia y no poner ninguna otra me la vuelva a poner en el color original, en este caso rojo
Lo que me consultaste anteriormente no era esto precisamente, sino cómo borrar varias celdas al mismo tiempo.
No hay manera de 'saber' qué color tenía la celda anteriormente, solo podes guardar 1 x vez, salvo que todas tienen un fondo, por ej rojo.
Entonces cada vez que borrás alguna te vuelve a colocar rojo
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Asigna color segun provincia insertada en Hoja Datos
If Target.Count > 1 then
target.interior.colorindex = 3
Exit Sub
end if
Set Relcell = Range("B7:B28")
If Not Application.Intersect(Relcell, Range(Target.Address(False, False))) Is Nothing Then
dato = Target.Value
If IsEmpty(dato) Then
Target.Interior.ColorIndex = 3
Else
Set busco = ActiveSheet.Range("H2:H50").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not busco Is Nothing Then
Target.Interior.ColorIndex = busco.Offset(0, 1).Interior.ColorIndex
End If
Set busco = Nothing
End If
End If
Set Relcell = Nothing
End Sub
Sdos
Elsa
Así cuando borro me pone el color rojo, el problema es que el color inicial de la celda no siempre es el rojo unas veces puede ser amarillo otras azul, etc,
¿Puede ser de utilidad si en columna d12 a d30 tienen el mismo color (rojo), pero si posteriormente cambio y en d12 al d30 tienen el mismo color (verde) y solo voy a modificar el color con la macro al poner el nombre de la provincia del d13 al de 30 en el caso de borrar el nombre de la provincia, o sea celda vacía me copie el color de su columna en fila 12 y sucesivamente me pase lo mismo en cada columna?
Me mareaste... enviame una hoja con lo que quieras obtener y así lo desarrollo sobre tu modelo. Encontrarás el correo en mi sitio (o dejame el tuyo aquí)
Sdos

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas