Colorear facilmente la fila activa

Hola
Esta es una forma facil de pintar la fila activa en Excel mediante VBA

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Rem conseguimos la ultima celda ocupada de la columna A
uf = Range("A" & Rows.Count).End(xlUp).Row
Rem trabajaremos con Target/Objetivo
With Target
    Rem si la columna activa se localiza despues de la columna E
    Rem si la fila activa es menor que 5
    Rem si la fila activa es mayor que uf (ultima fila ocupada)
    Rem >>> entonces salir de la rutina
    If .Column > 5 Or .Row < 5 Or .Row > uf Then Exit Sub
    Rem trabajando con el rango Range("A5:E" & uf)
    With Range("A5:E" & uf)
        Rem ningun color
        .Interior.ColorIndex = xlNone
        Rem negrita desactivada
        .Font.Bold = False
    End With
    Rem trabajar con la celda/fila activa
    With Range(Cells(.Row, 1), Cells(.Row, 5))
        Rem color a 6 (amarillo)
        .Interior.ColorIndex = 6
        Rem negrita activada
        .Font.Bold = True
    End With
End With
End Sub

Espero que sea de mucha utilidad

Saludos desde Honduras

Validacion de datos (tipo Google)

Hola
He preparado la siguiente lista dinamica (validacion de datos), solo se debe escribir la(s) letra(s) y pinchar o dar clic en la flechita de validacion para ver los datos encontrados segun el criterio

He usado la funcion INDICE, COINCIDIR y CONTARSI

Espero sea de mucha utilidad

Saludos desde Honduras

https://1drv.ms/x/s!ArXFzDCBi3UYgllU_n4XKBBWfinR

Eliminar Duplicados

Hola a todos!
De nuevo regreso con un aporte mas...

A raiz de varios temas similares (en uno de los foros que frecuento), y que muchos usuarios buscan este tipo de ayuda, y bueno me refiero a eliminar duplicados, aunque Excel, trae consigo esta herramienta, tenemos que decir que solo es validad para columnas continuas, o si seleccionamos una BD que tenga registros iguales, es decir en modo de filas y funciona perfectamente. Bueno la limitante de esta poderosa herramienta es que no elimina registros o datos, cuando por ejemplo en varios registros hay igualdad, pero en dos columnas no continuas... a continuacion adjunto un archivo, donde la columna "A" que es la Matricula y la columna "F" que son los Kilometros, y que la macro elminara todos los registros iguales, dejando solo uno de ellos

Espero que sirva

Sub Elimina_duplicadosGP()

Dim uf As Long, ColA As Long, ColF As Long, Eliminados As Long
With Application
    .ScreenUpdating = False
    uf = Range("A" & Rows.Count).End(xlUp).Row
    Eliminados = 0
    For x = uf To 3 Step -1
        ColA = .CountIf(Range("A2:A" & x), Range("A" & x))
        ColF = .CountIf(Range("F2:F" & x), Range("F" & x))
        If ColA > 1 And ColF > 1 Then Eliminados = Eliminados + 1: Rows(x).Delete '.Interior.ColorIndex = 6
    Next
    With .ActiveWindow
        .ScrollColumn = 1: .ScrollRow = 1: Range("A1").Select
    End With
    .ScreenUpdating = True
    If Eliminados = 0 Then _
    MsgBox "No existen registros que eliminar", vbExclamation, "Informacion": Exit Sub
    MsgBox "Registros eliminados:  " & VBA.Format(Eliminados, "#,##0"), vbInformation, "Exito!"
End With

End Sub

Saludos desde Honduras

Extraer numeros de cadena alfanumerica (mejorada)

Hola!
Esta vez aportare una formula la cual sirve para extraer solo numeros de una cadena de texto (o sea de una celda), pues bien la he mojorado, ya que con un colega en otro foro, la referenciamos y me pico lo adicto y la mejore para que sea utilizada en diferentes idiomas de Excel

Mejoras
1- Modifique esto a =COINCIDIR(VERDADERO... por esto =COINCIDIR(1...
2- Modifique esto = FILA($1:$9)... por esto FILA(INDIRECTO(1&":"&LARGO(A2)))...
3- Modifique esto =1*EXTRAE(... por esto =--EXTRAE(... {en toda la formula}

=--EXTRAE(A2,COINCIDIR(1,--ESNUMERO(--EXTRAE(A2,FILA(INDIRECTO(1&":"&LARGO(A2))),1)),),CONTAR(--EXTRAE(A2,FILA(INDIRECTO(1&":"&LARGO(A2))),1)))

Espero sea de utilidad y comprension para todos

La formula original/fuente se encuentra aqui: Extraer numeros de cadena alfanumerica
Proporcionado por Microsoft MVP Ashish Mathur

Saludos desde Honduras

Sustituir contra Reemplazar (Substitute vrs Replace)

Hola a todos
Como el titulo lo indica, estas dos funciones son muy similares, pero "Replace" tiena ventaja... explico

Ayuda de la funcion Application.WorksheetFunction.Substitute: El método Substitute reemplaza el texto nuevo por el texto original dentro de una cadena de texto. Utilice el método Substitute cuando desee reemplazar texto específico en una cadena de texto; use el método Replace si desea reemplazar cualquier texto que aparezca en una ubicación específica dentro de una cadena de caracteres.

Sintaxis
expresión.Substitute(Arg1, Arg2, Arg3, Arg4)
expresión Variable que representa un objeto WorksheetFunction.

Ayuda de la funcion VBA.Replace: Devuelve una cadena en la que se reemplazó una subcadena especificada con otra subcadena un número especificado de veces.

Sintaxis
Replace(expresión, encontrar, reemplazarCon [, inicio[, Contar[, comparar]]])

Imaginemos una columna con datos, y que a esta en cada celda se debe reemplazar o sustituir algunos caracteres, pues bien he elaborado un archivo en el cual pueden realizar pruebas y notar, que la ventaja de VBA.Replace es que se puede reemplazar los caracteres cuantas ( Contar[ )veces necesite dentro de la cadena de texto, por el contrario Substitute tiene la limitante de poder hacerlo solo una vez

SUBSTITUTE:

Sub sustituir()
    Dim texto1 As String
    Dim texto2 As String
    texto1 = Application.InputBox("Sustituir!", "Texto1", , , , Type:=1 + 2)
    texto2 = Application.InputBox("Sustituir!", "Texto2", , , , Type:=1 + 2)
    With Application
        .ScreenUpdating = False
        For x = 2 To Range("A" & Rows.Count).End(xlUp).Row
            Cells(x, 1) = .Trim(.Substitute(Cells(x, 1), texto1, "", 1))
            Cells(x, 1) = .Trim(.Substitute(Cells(x, 1), texto2, "", 1))
        Next x
        .ScreenUpdating = True
    End With
    Range("A1").Select
End Sub

REPLACE

Sub reemplazar()
    Dim texto1 As String
    Dim texto2 As String
    texto1 = Application.InputBox("Reemplazar!", "Texto1", , , , Type:=1 + 2)
    texto2 = Application.InputBox("Reemplazar!", "Texto2", , , , Type:=1 + 2)
    With Application
        .ScreenUpdating = False
        For x = 2 To Range("A" & Rows.Count).End(xlUp).Row
            Cells(x, 1) = VBA.Trim(Replace(Cells(x, 1), texto1, "", 1, 1))
            Cells(x, 1) = VBA.Trim(Replace(Cells(x, 1), texto2, "", 1, 1))
        Next x
        .ScreenUpdating = True
    End With
    Range("A1").Select
End Sub

NOTA: no confundir ninguna de las dos funciones arriba con Application.WorksheetFunction.Replace si necesitan ver la diferencia busquen en la ayuda de VBA en Excel

Espero sea de mucha utilidad y experimento jeje

Saludos desde Honduras