mostrar mensaje mientras se ejecuta un macro

Héctor: aún ando por aquí, gracias por tu interés (croeo que ya te lo había
dicho).
Voy a probar lo que me mandás y te prometo (si quieres y con tu permiso) te
mando la planilla que estoy trabajando, para ver si te sirve de algo...
He probado lo que me propusiste con la función RANK y la verdad que hace en
pocas líneas lo que a mí me costaba UNAS CUANTAS.
Estoy aprendiendo mucho con tus enseñanzas.
Muchas gracias (y espero no ser tan pesado en decírtelo)
Leonardo Trujillo

"Héctor Miguel" escribió en el mensaje
news:

hola, Leo !

> ... entiendo lo que me explicaste muy claramente, espero tus

comentarios...

por si todavia 'andas por aqui' :D

si la logica no se me ha ido muy lejos de vacaciones... [segun yo]...
la siguiente fraccion de codigo 'hace' el arreglo que necesitas de los 5

'bloques' [en menos lineas y tiempo]

no he llegado a las formulas que pones en la hoja 'temp' a partir de la

columna 'I'

ni a los formatos que aplicas a ciertos rangos :-((
[y no se que haga la macro que llamas con nombre de:

sertartítulo'] -???-

corre algunas pruebas con una copia de tus archivos originales y...

comentas si vamos por buen camino ?

saludos,
hector.

Sub Agiliza_Premiacion()
Dim Busca As Variant, Sig As Byte, Fila_1 As Integer, Fila_2 As Integer
Busca = Array("pre-infantil", "infantil", "infantil a", "infantil b",

"juvenil", "")

Worksheets("premiación nivel 1").Cells.Clear
Worksheets("nivel 1").Select
For Sig = LBound(Busca) To UBound(Busca) - 1
Fila_1 = Evaluate("match(""" & Busca(Sig) & """,a:a,0)") + 1
Fila_2 = IIf(Busca(Sig + 1) <> "", Evaluate("match(""" & Busca(Sig +

1) & """,a:a,0)") - 1, _

Range("g65536").End(xlUp).Row)
Range("a" & Fila_1 & ":i" & Fila_2).Copy _
Destination:=Worksheets("premiación nivel

1").Range("a65536").End(xlUp).Offset(2)

Next
Worksheets("premiación nivel 1").Columns("a:i").EntireColumn.AutoFit
Worksheets("premiación nivel 1").Columns("h:h").columnswidth = 1.71
insertartítulo ' ESTA MACRO NO SE QUE HACE ???'
With Worksheets("temp")
.Range("a1:g1") = Array("Nombre", "Club", "AP1", "AP2", "AP3", "AP4",

"Total")

Worksheets("nivel 1").Range("a8:g1000").Copy Destination:=.Range("a2")
.Range("a2:g1000").Sort Key1:=Range("b2"), Order1:=xlAscending, _
Key2:=Range("g2"),

Order2:=xlDescending, Header:=xlYes

.Range("i1:p1") = Array("Campus", "CAR", "CDM", "EDG", "Gymnastics",

"Olimpia", "Performance", "Solis")

End With
' AQUI SEGUIRIAN LAS FORMULAS Y LOS FORMATOS ...'
End Sub

p.d. tampoco veo como es que llamas a algun MsgBox ??? [pero supongo

que puedes usar constantes al inicio del modulo +/- asi]:

Public Const Mensaje As String = "Asegúrese que no hay una hoja en este

libro que se llame PREMIACIÓN" & vbCr & _

"Si la hubiera, antes de seguir ELIMÍNELA, o el programa le dará

un error" & vbCr & _

"¿Está seguro de seguir?" ' Define el mensaje
Public Const Estilo As Integer = vbYesNoCancel + vbQuestion +

vbDefaultButton2 ' Define los botones

Public Const Título As String = "¡¡¡ C U I D A D O !!!" ' Define el título
Public Const Ayuda As String = "demo.hlp" ' Define el archivo de ayuda
Public Const Ctxt As Integer = 1000 ' Define el tema

Héctor Miguel: he porbado el código que me mandaste. Me genera un error (el
tipo no coincide) en la línea
Fila_2 = IIf(Busca(Sig + 1) <> "", Evaluate("match(""" & Busca(Sig + 1) &
""",a:a,0)") - 1, Range("g65536").End(xlUp).Row) y es cuando llega al final
de la lista, o sea, cuando Busca(Sig + 1) = "".

Me preguntabas qué hacía la macro insertartítulo: a la hoja premiación le
agrega un título y una explicación de lo que se muestra en ella, insertando
filas a la hoja premiación.

Saludos
leonardo trujillo
"Héctor Miguel" escribió en el mensaje
news:

hola, Leo !

> ... entiendo lo que me explicaste muy claramente, espero tus

comentarios...

por si todavia 'andas por aqui' :D

si la logica no se me ha ido muy lejos de vacaciones... [segun yo]...
la siguiente fraccion de codigo 'hace' el arreglo que necesitas de los 5

'bloques' [en menos lineas y tiempo]

no he llegado a las formulas que pones en la hoja 'temp' a partir de la

columna 'I'

ni a los formatos que aplicas a ciertos rangos :-((
[y no se que haga la macro que llamas con nombre de:

sertartítulo'] -???-

corre algunas pruebas con una copia de tus archivos originales y...

comentas si vamos por buen camino ?

saludos,
hector.

Sub Agiliza_Premiacion()
Dim Busca As Variant, Sig As Byte, Fila_1 As Integer, Fila_2 As Integer
Busca = Array("pre-infantil", "infantil", "infantil a", "infantil b",

"juvenil", "")

Worksheets("premiación nivel 1").Cells.Clear
Worksheets("nivel 1").Select
For Sig = LBound(Busca) To UBound(Busca) - 1
Fila_1 = Evaluate("match(""" & Busca(Sig) & """,a:a,0)") + 1
Fila_2 = IIf(Busca(Sig + 1) <> "", Evaluate("match(""" & Busca(Sig +

1) & """,a:a,0)") - 1, _

Range("g65536").End(xlUp).Row)
Range("a" & Fila_1 & ":i" & Fila_2).Copy _
Destination:=Worksheets("premiación nivel

1").Range("a65536").End(xlUp).Offset(2)

Next
Worksheets("premiación nivel 1").Columns("a:i").EntireColumn.AutoFit
Worksheets("premiación nivel 1").Columns("h:h").columnswidth = 1.71
insertartítulo ' ESTA MACRO NO SE QUE HACE ???'
With Worksheets("temp")
.Range("a1:g1") = Array("Nombre", "Club", "AP1", "AP2", "AP3", "AP4",

"Total")

Worksheets("nivel 1").Range("a8:g1000").Copy Destination:=.Range("a2")
.Range("a2:g1000").Sort Key1:=Range("b2"), Order1:=xlAscending, _
Key2:=Range("g2"),

Order2:=xlDescending, Header:=xlYes

.Range("i1:p1") = Array("Campus", "CAR", "CDM", "EDG", "Gymnastics",

"Olimpia", "Performance", "Solis")

End With
' AQUI SEGUIRIAN LAS FORMULAS Y LOS FORMATOS ...'
End Sub

p.d. tampoco veo como es que llamas a algun MsgBox ??? [pero supongo

que puedes usar constantes al inicio del modulo +/- asi]:

Public Const Mensaje As String = "Asegúrese que no hay una hoja en este

libro que se llame PREMIACIÓN" & vbCr & _

"Si la hubiera, antes de seguir ELIMÍNELA, o el programa le dará

un error" & vbCr & _

"¿Está seguro de seguir?" ' Define el mensaje
Public Const Estilo As Integer = vbYesNoCancel + vbQuestion +

vbDefaultButton2 ' Define los botones

Public Const Título As String = "¡¡¡ C U I D A D O !!!" ' Define el título
Public Const Ayuda As String = "demo.hlp" ' Define el archivo de ayuda
Public Const Ctxt As Integer = 1000 ' Define el tema

hla, leonardo !

... porbado el codigo... genera un error (el tipo no coincide) en la linea
Fila_2 = IIf(Busca(Sig + 1) <> "", Evaluate("match(""" & Busca(Sig + 1) & """,a:a,0)") - 1, _
Range("g65536").End(xlUp).Row)
y es cuando llega al final de la lista, o sea, cuando Busca(Sig + 1) = ""...

[segun parece] vba no acepta [lo que considera] 'mezcla' de tipos combinando la funcion 'Evaluate' dentro de un Iif(... :-((

modifica la linea donde se asigna el valor a la variable 'Fila_2' ... de:

Fila_2 = IIf(Busca(Sig + 1) = "", Range("g65536").End(xlUp).Row, _
Evaluate("match(""" & Busca(Sig + 1) & """,a:a,0)") - 1)

por alguna de las siguientes alternativas:

op1: [solo podria 'cumplirse' una de las dos condiciones If...]
If Busca(Sig + 1) = "" Then Fila_2 = Range("g65536").End(xlUp).Row
If Busca(Sig + 1) <> "" Then Fila_2 = Evaluate("match(""" & Busca(Sig + 1) & """,a:a,0)") - 1

op2: cambiando la funcion Iif( por un simple y sencillo If...Then...Else
If Busca(Sig + 1) = "" Then Fila_2 = Range("g65536").End(xlUp).Row _
Else Fila_2 = Evaluate("match(""" & Busca(Sig + 1) & """,a:a,0)") - 1

op3: usando una estructura con el Select Case
Select Case Busca(Sig + 1)
Case "": Fila_2 = Range("g65536").End(xlUp).Row
Case Else: Fila_2 = Evaluate("match(""" & Busca(Sig + 1) & """,a:a,0)") - 1
End Select

saludos,
hector.

Héctor Miguel escribió:

hla, leonardo !

... porbado el codigo... genera un error (el tipo no coincide) en la linea
Fila_2 = IIf(Busca(Sig + 1) <> "", Evaluate("match(""" & Busca(Sig + 1) & """,a:a,0)") - 1, _
Range("g65536").End(xlUp).Row)
y es cuando llega al final de la lista, o sea, cuando Busca(Sig + 1) = ""...

[segun parece] vba no acepta [lo que considera] 'mezcla' de tipos combinando la funcion 'Evaluate' dentro de un Iif(... :-((

modifica la linea donde se asigna el valor a la variable 'Fila_2' ... de:

Fila_2 = IIf(Busca(Sig + 1) = "", Range("g65536").End(xlUp).Row, _
Evaluate("match(""" & Busca(Sig + 1) & """,a:a,0)") - 1)

por alguna de las siguientes alternativas:

op1: [solo podria 'cumplirse' una de las dos condiciones If...]
If Busca(Sig + 1) = "" Then Fila_2 = Range("g65536").End(xlUp).Row
If Busca(Sig + 1) <> "" Then Fila_2 = Evaluate("match(""" & Busca(Sig + 1) & """,a:a,0)") - 1

op2: cambiando la funcion Iif( por un simple y sencillo If...Then...Else
If Busca(Sig + 1) = "" Then Fila_2 = Range("g65536").End(xlUp).Row _
Else Fila_2 = Evaluate("match(""" & Busca(Sig + 1) & """,a:a,0)") - 1

op3: usando una estructura con el Select Case
Select Case Busca(Sig + 1)
Case "": Fila_2 = Range("g65536").End(xlUp).Row
Case Else: Fila_2 = Evaluate("match(""" & Busca(Sig + 1) & """,a:a,0)") - 1
End Select

saludos,
hector.

Ok, lo pruebo y por cualquier cosa aviso.
Gracias
Leonardo Trujillo

Héctor: encontré la forma de que la barra de progreso se complete a
medida que se ejecutan las órdenes, aunque no haya una recursión.
He usado el código que optimiza mi macro y me ha sido de utilidad.
Te agradezco por la atención prestada y seguiremos en otro hilo
saludos
leonardo trujillo