Macro que pida un valor y busque dicho valor en una columna de una hoja y coloque color de relleno, color de letra y negrilla
Me gustaría que me ayudaran con la siguiente macro. Tengo una hoja llamada "CARTERA" y en dicha hoja en la columna "AZ" tengo números de contacto. También en ese mismo libro tengo una hoja llamada "CLIENTES" y en dicha hoja en la columna "i" tengo también números de contacto. Lo que necesito es una macro que al ejecutarla, me solicite ingresar un valor (en este caso seria un número de contacto) y al dar click en Ok o Aceptar el me busque dicho valor en ambas hojas (en Cartera en la columna AZ y en Clientes columna i). Se puede dar el caso que ese numero de contacto, no exista por lo tanto la macro sacaría un mensaje que diría que ese número de contacto no existe en ninguna base de datos y terminaría la macro. También se dar el caso que si exista y no solo eso que estuviera repetido en la hoja CARTERA columna AZ, lo que deseo es que a cada celda que contenga ese número de contacto, la macro resalte la celda con color de relleno verde, color de letra negro y negrilla, tanto en la hoja Cartera columna AZ como en la hoja Clientes columna i.
2 Respuestas
En un módulo del Editor copia la siguiente macro:
Sub buscarCodigo()
'x Elsamatilde
'solicitar código a buscar
codi = InputBox("Ingresa el código a buscar")
If codi = "" Then Exit Sub
esta = 0
'busca en las 2 hojas
With Sheets("CARTERA")
Set busco = .Range("AZ:AZ").Find(codi, LookIn:=xlValues, lookat:=xlWhole)
If Not busco Is Nothing Then
esta = 1
x = busco.Row
Do
With .Range("AZ" & busco.Row)
.Interior.ColorIndex = 4
.Font.ColorIndex = xlAutomatic
.Font.Bold = True
End With
Set busco = .Range("AZ:AZ").FindNext(busco)
Loop While Not busco Is Nothing And busco.Row <> x
End If
End With
'sigue la búsqueda en la otra hoja
With Sheets("CLIENTE")
Set busco = .Range("I:I").Find(codi, LookIn:=xlValues, lookat:=xlWhole)
If Not busco Is Nothing Then
esta = 1
x = busco.Row
Do
With .Range("I" & busco.Row)
.Interior.ColorIndex = 4
.Font.ColorIndex = xlAutomatic
.Font.Bold = True
End With
Set busco = .Range("I:I").FindNext(busco)
Loop While Not busco Is Nothing And busco.Row <> x
End If
End With
If esta = 0 Then
MsgBox "No se encontró el código en las hojas de la base."
Else
MsgBox "Fin del proceso."
End If
End SubSeguramente ya sabes cómo ejecutarla ;)
TE recuerdo que las respuestas te fueron entregadas ya en tiempo y forma. No olvides valorarlas para darlas por cerradas.
Sdos!
Aquí te dejo otra macro con otro enfoque para tu consideración.
Sub CambiarColor()
Dim codigo As Variant, a As Variant, hs As Variant
Dim i As Long, h As Long, r As Range, existe As Boolean
codigo = Application.InputBox("ingresar un número de contacto", "CAMBIAR COLOR")
If codigo = Empty Then Exit Sub
If IsNumeric(codigo) Then codigo = Val(codigo)
hs = Array("CARTERA", "AZ", "CLIENTE", "I")
For h = 0 To UBound(hs) Step 2
Set r = Nothing
a = Sheets(hs(h)).Range(hs(h + 1) & 1, Sheets(hs(h)).Range(hs(h + 1) & Rows.Count).End(3)).Value2
For i = 1 To UBound(a)
If a(i, 1) = codigo Then If r Is Nothing Then Set r = Sheets(hs(h)).Range(hs(h + 1) & i) Else Set r = Union(r, Sheets(hs(h)).Range(hs(h + 1) & i))
Next
If Not r Is Nothing Then
existe = True
r.Interior.Color = vbGreen
r.Font.Color = vbBlack
r.Font.FontStyle = "Negrita"
End If
Next
If existe Then MsgBox "Fin" Else MsgBox "Número no existe"
End Sub