Como utilizar dos macros que empiezan con Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Quiero integrar dos macros que realizan una funcion cada una pero el asunto es que las dos deben funcionar el la misma hoja y empiezan con Private Sub Worksheet_SelectionChange(ByVal Target As Range) y a la hora de ejecutar las dos marcan error. ¿Qué debo modificar para que funcionen? Si alguien me puede ayudar. Anexo las dos macros.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim fil As Integer
fil = 2
If ActiveCell.Row = 1 And ActiveCell.Column = 4 Then
limpiar
For i = 3 To 2500
existe = InStr(Sheets("Folios Maritimos").Cells(i, 7), Sheets("Buscador").Range("D1"))
If existe Then
fil = fil + 1
Sheets("Buscador").Cells(fil, 1) = Sheets("Folios Maritimos").Cells(i, 1)
Sheets("Buscador").Cells(fil, 2) = Sheets("Folios Maritimos").Cells(i, 2)
Sheets("Buscador").Cells(fil, 3) = Sheets("Folios Maritimos").Cells(i, 3)
Sheets("Buscador").Cells(fil, 4) = Sheets("Folios Maritimos").Cells(i, 4)
Sheets("Buscador").Cells(fil, 5) = Sheets("Folios Maritimos").Cells(i, 5)
Sheets("Buscador").Cells(fil, 6) = Sheets("Folios Maritimos").Cells(i, 6)
Sheets("Buscador").Cells(fil, 7) = Sheets("Folios Maritimos").Cells(i, 7)
Sheets("Buscador").Cells(fil, 8) = Sheets("Folios Maritimos").Cells(i, 8)
Sheets("Buscador").Cells(fil, 9) = Sheets("Folios Maritimos").Cells(i, 9)
Sheets("Buscador").Cells(fil, 10) = Sheets("Folios Maritimos"). Cells(i, 10)
Sheets("Buscador").Cells(fil, 11) = Sheets("Folios Maritimos"). Cells(i, 11)
Sheets("Buscador").Cells(fil, 12) = Sheets("Folios Maritimos"). Cells(i, 12)
Sheets("Buscador").Cells(fil, 13) = Sheets("Folios Maritimos"). Cells(i, 13)
Sheets("Buscador").Cells(fil, 14) = Sheets("Folios Maritimos"). Cells(i, 14)
Sheets("Buscador").Cells(fil, 15) = Sheets("Folios Maritimos"). Cells(i, 15)
Sheets("Buscador").Cells(fil, 16) = Sheets("Folios Maritimos"). Cells(i, 16)
End If
Next i
End If
Sheets("Buscador").Select
Range("D1").Select
End Sub
Sub limpiar()
For i = 3 To 2500
If Cells(i, 1) = Empty Then
Exit Sub
End If
Cells(i, 1) = Empty
Cells(i, 2) = Empty
Cells(i, 3) = Empty
Cells(i, 4) = Empty
Cells(i, 5) = Empty
Cells(i, 6) = Empty
Cells(i, 7) = Empty
Cells(i, 8) = Empty
Cells(i, 9) = Empty
Cells(i, 10) = Empty
Cells(i, 11) = Empty
Cells(i, 12) = Empty
Cells(i, 13) = Empty
Cells(i, 14) = Empty
Cells(i, 15) = Empty
Cells(i, 16) = Empty
Next i
End Sub

y esta es la otra

Option ExplicitPrivate Sub Worksheet_Change(ByVal Target As Range)    If Not Intersect(Target, Range(" d1")) Is Nothing Then        Target.Value = AMayusculas(Target.Value)    End IfEnd Sub

Y tengo parte de esta que va en el modulo

Option ExplicitPublic Function AMayusculas(strTexto As String) As String    AMayusculas = UCase(strTexto)End Function

2 Respuestas

Respuesta
1

Así te deben funcionar las dos cosas. Cuando tengas varias cosas que "controlar" en un evento, ponlas en el mismo evento, no puedes tener el mismo evento dos veces en la misma hoja.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim fil As Integer
If Not Intersect(Target, Range("d1")) Is Nothing Then
    Target.Value = AMayusculas(Target.Value)
End If
fil = 2
If ActiveCell.Row = 1 And ActiveCell.Column = 4 Then
    limpiar
    For i = 3 To 2500
    existe = InStr(Sheets("Folios Maritimos").Cells(i, 7), Sheets("Buscador").Range("D1"))
        If existe Then
            fil = fil + 1
            For T = 1 To 16
             shetts("Buscador").Cells(fil, T) = Sheets("Folios Maritimos").Cells(i, T)
            Next T
        End If
    Next i
End If
Sheets("Buscador").Select
Range("D1").Select
End Sub
''
Sub limpiar()
For i = 3 To 2500
    If Cells(i, 1) = Empty Then
        Exit Sub
    End If
    For T = 1 To 14: Cells(i, T) = Empty: Next T
Next i
End Sub

Te he modificado un poco el código, he introducido bucles para que no tengas que repetir la misma instrucción varias veces.

Si te ha valido la respuesta.

Te agradezco tu pronta respuesta Marcial copie y pegue lo que modificaste pero no funciono me marca de amarillo la primera fila y me sale un mensaje diciendo que error de compilación No se ha definido Sub o Function

Había un error de sintaxis en una línea y además no te incluí la función AMayusculas. De todas formas, no hace falta que crees una función para llamar a una función integrada en Excel como es UCase. Ponlo así y elimina la función AMayusculas.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim fil As Integer
If Not Intersect(Target, Range("d1")) Is Nothing Then
    Target.Value = UCase(Target.Value)
End If
fil = 2
If ActiveCell.Row = 1 And ActiveCell.Column = 4 Then
    limpiar
    For i = 3 To 2500
    existe = InStr(Sheets("Folios Maritimos").Cells(i, 7), Sheets("Buscador").Range("D1"))
        If existe Then
            fil = fil + 1
            For T = 1 To 16
             Sheets("Buscador").Cells(fil, T) = Sheets("Folios Maritimos").Cells(i, T)
            Next T
        End If
    Next i
End If
Sheets("Buscador").Select
Range("D1").Select
End Sub
''
Sub limpiar()
For i = 3 To 2500
    If Cells(i, 1) = Empty Then
        Exit Sub
    End If
    For T = 1 To 14: Cells(i, T) = Empty: Next T
Next i
End Sub

Si te ha valido la respuesta.

que tal Marcial ya copie el código modificado y ahora me resalta de amarillo este texto  Target.Value = UCase(Target.Value) y me manda un mensaje  se ha producido un error 13 entiempo de ejecución  no coinciden los tipos.

Pon esto:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim fil As Integer
If Not Intersect(Target, Range("D1")) Is Nothing Then
Application.EnableEvents = False
  For Each cel In Target
    cel.Value = UCase(cel)
  Next
Application.EnableEvents = True
End If
fil = 2
If ActiveCell.Row = 1 And ActiveCell.Column = 4 Then
    limpiar
    For i = 3 To 2500
    existe = InStr(Sheets("Folios Maritimos").Cells(i, 7), Sheets("Buscador").Range("D1"))
        If existe Then
            fil = fil + 1
            For T = 1 To 16
             Sheets("Buscador").Cells(fil, T) = Sheets("Folios Maritimos").Cells(i, T)
            Next T
        End If
    Next i
End If
Sheets("Buscador").Select
'Range("D1").Select
End Sub
''
Sub limpiar()
For i = 3 To 2500
    If Cells(i, 1) = Empty Then
        Exit Sub
    End If
    For T = 1 To 14: Cells(i, T) = Empty: Next T
Next i
End Sub
Respuesta
1

Te dejo la macro del evento Change ajustada. No necesitas de la función y además estoy controlando que solo se ejecute cuando ingresas un valor en D1. El otro código agregado es para que no se ejecute cuando intentas borrar su contenido (en este caso también te está dando error con la función).

Private Sub Worksheet_Change(ByVal Target As Range)
'ajustada x Elsamatilde
'si se seleccionan varias celdas juntas no se ejecuta
If Target.Count > 1 Then Exit Sub
'solo se ejecuta cuando se ingresa un dato en D1
If Not Intersect(Target, Range("D1")) Is Nothing Then
If Target.Value <> "" Then
    Target.Value = UCase(Target.Value)
End If
End If
End Sub

El otro códio se ejecuta en el evento Selectin_Change, lo que significa que se ejecutará solo al 'seleccionar' alguna celda indicada... comenta si esto está bien o debe ser también incluída en el evento Change.

Sdos... no finalices aún hasta que completemos el tema

Elsa

Remarco la aclaración: si bien tu consulta dice de unir 2 eventos Selection_Change, en realidad tenés un evento Change (cambio) y otro Seleccion_Change (selección).

La primera ya te la envié ajustada (Change). Ahora confirma si deseas mantener el otro evento y en ese caso puedo ajustarla para que entre ambas no se generen conflictos.

Si pruebas el código de Marcial y responde a tu necesidad, tanto al seleccionar alguna celda como al introducir o borrar valores, entonces me lo comentas y doy por cerrado el tema aquí.

te agradezco elsa probé con el código que me dio Marcial pero me manda error, si necesito los dos eventos. voy ampliar mas la explicación de mi problema a ver si sea mas fácil encontrar una solución: tengo un libro con dos hojas, en la primera hoja se llama Buscador  tengo la fila A1 a la C1 combinada  en la D1 a la G1 tambien la tengo combinada y en la A2 a la P16 tengo   un encabezado  con  16 columnas con diferentes nombres cada columna. entonces cuando yo escribo una palabra en MAYUSCULA  en la celda combinada D1 a G1 me busca y copia toda la fila donde se encuentra esa palabra que seria de la hoja 2 que se llama Folios Maritimos. entonces  si yo escribo en minusculas no me encuentra nada en cambio con mayusculas si lo hace. esta idea la quite de este ejemplo:https://www.youtube.com/watch?v=MInhj6hH_dQ   para que se den una idea de lo que quiero hacer. gracias 

Para tu tranquilidad esto es mucho más sencillo de lo que pensabas.

Primero te comenté que no te hacía falta la Función y ahora te comento que ni siquiera necesitas el evento Change para pasar a mayúsculas.

Si a la línea de la búsqueda le agregas la función UCASE ya lo tenés resuelto:

existe = InStr(Sheets("Folios Maritimos"). Cells(i, 7), UCase(Sheets("Buscador"). Range("D1")))

Te la paso completa con el ajuste para que se ejecute solo al seleccionar ese rango.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'ajustada y comentada x Elsamatilde
Dim fil As Integer
fil = 2
'solo se ejecuta al seleccionar celda D1 (combinada)
If Intersect(Target, Range("D1:G1")) Is Nothing Then Exit Sub
'comienza el proceso para D1
limpiar
For i = 3 To 2500
existe = InStr(Sheets("Folios Maritimos").Cells(i, 7), UCase(Sheets("Buscador").Range("D1")))
If existe Then
    fil = fil + 1
    Sheets("Buscador").Cells(fil, 1) = Sheets("Folios Maritimos").Cells(i, 1)
    Sheets("Buscador").Cells(fil, 2) = Sheets("Folios Maritimos").Cells(i, 2)
    Sheets("Buscador").Cells(fil, 3) = Sheets("Folios Maritimos").Cells(i, 3)
    Sheets("Buscador").Cells(fil, 4) = Sheets("Folios Maritimos").Cells(i, 4)
    Sheets("Buscador").Cells(fil, 5) = Sheets("Folios Maritimos").Cells(i, 5)
    Sheets("Buscador").Cells(fil, 6) = Sheets("Folios Maritimos").Cells(i, 6)
    Sheets("Buscador").Cells(fil, 7) = Sheets("Folios Maritimos").Cells(i, 7)
    Sheets("Buscador").Cells(fil, 8) = Sheets("Folios Maritimos").Cells(i, 8)
    Sheets("Buscador").Cells(fil, 9) = Sheets("Folios Maritimos").Cells(i, 9)
    Sheets("Buscador").Cells(fil, 10) = Sheets("Folios Maritimos"). Cells(i, 10)
    Sheets("Buscador").Cells(fil, 11) = Sheets("Folios Maritimos"). Cells(i, 11)
    Sheets("Buscador").Cells(fil, 12) = Sheets("Folios Maritimos"). Cells(i, 12)
    Sheets("Buscador").Cells(fil, 13) = Sheets("Folios Maritimos"). Cells(i, 13)
    Sheets("Buscador").Cells(fil, 14) = Sheets("Folios Maritimos"). Cells(i, 14)
    Sheets("Buscador").Cells(fil, 15) = Sheets("Folios Maritimos"). Cells(i, 15)
    Sheets("Buscador").Cells(fil, 16) = Sheets("Folios Maritimos"). Cells(i, 16)
End If
Next i
Sheets("Buscador").Select
Range("D1").Select
End Sub

Probala y si el tema queda resuelto, no olvides valorar mi respuesta.

Muchas gracias Elsa, probé el código que mandas pero me marco error, pero ya se soluciono mi asunto con el código que me mando Marcial. Te todas formas te agradezco muchísimo tu ayuda, ya que me respondiste luego. Te dejo el código como quedo. Saludos...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim fil As Integer
If Not Intersect(Target, Range("D1")) Is Nothing Then
Application.EnableEvents = False
For Each cel In Target
cel.Value = UCase(cel)
Next
Application.EnableEvents = True
End If
fil = 2
If ActiveCell.Row = 1 And ActiveCell.Column = 4 Then
limpiar
For i = 3 To 2500
existe = InStr(Sheets("Folios Maritimos").Cells(i, 7), Sheets("Buscador").Range("D1"))
If existe Then
fil = fil + 1
For T = 1 To 16
Sheets("Buscador").Cells(fil, T) = Sheets("Folios Maritimos").Cells(i, T)
Next T
End If
Next i
End If
Sheets("Buscador").Select
Range("D1").Select
End Sub
Sub limpiar()
For i = 3 To 2500
If Cells(i, 1) = Empty Then
Exit Sub
End If
For T = 1 To 16: Cells(i, T) = Empty: Next T
Next i
End Sub

Solo deseo aclarar que el código enviado es totalmente CORRECTO, no dando errores, pero entiendo que utilizando 2 códigos diferentes te pueda haber quedado algún detalle fallando.

Quizás si hubieses probado cada respuesta en una copia distinta hubieses reparado que ambas cumplen con lo solicitado, solo a diferencia que me mantuve en tu evento Selection (anulando la macro del evento Change) y ahora lo tienes en el evento Change.

Creo que la valoración no contempla mi dedicación. Considerando que te hice notar la falla en el uso de funciones adicionales para pasar a mayúsculas y la falla en el uso de 2 eventos distintos.

Aún puedes modificar la valoración si así lo consideras justo.

Sdos!

Buen día elsa, le agregue ucase a la función y si funciono bien, tenias razón que no estaba complicado el asunto, por eso ya cambie la valoración. Gracias.

OK, En caso de que recibas más de una respuesta, lo ideal es que cada una la pruebes en una copia distinta... pero no mezclarlas para no superponer código. Ya sabemos que una tarea se puede realizar de más de un modo y no por eso no ser correctos. Luego elijes el más optimizado o el que te resulte más cómodo según tu necesidad.

Sdos!

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas