crear macro para busquedas repetitivas

Hola wichi,

disculpame, pero no habia leido bien tu post con las explicaciones de
la hoja y no habia visto lo de la columna vacia entre los datos.

Cambia en los dos ultimos codigos donde pone: ->

For coB = 19 To .UsedRange.Columns.Count Step 3 -> cambia el 3 por un
4.

se supone que la primera 'cita' va en la columna 'S', la 2ª en 'W',
la 3ª en 'AA',etc

un saludo
Ivan

PD: sin animo de meterme donde no me llaman ¿las columnas vacias,
estan completamente vacias?¿sin titulos ni nada? si es asi, y no tiene
algun motivo especial, corres el riesgo (creo) de que no te ordene
todos los datos, si en algun momento quieres hacerlo (no me hagas mucho
caso).

"Ivan" escribió:

Hola wichi

el codigo 'BuscarCitas' que te pongo al final, busca en la hoja activa
(Activesheet) del libro, da lo mismo como se llame (puedes volver a
poner el que tubieras) las 'citas' con la fecha actual, la del dia de
busqueda (para el codigo no hace falta que pongas la fecha en ningun
sitio). Te pongo tambien otro 'BuscarPorFecha' que tambien busca en la
hoja activa, pero por la fecha que introduzcas en cuadro de dialogo. Ya
que esta, tambien puede serte util para buscar en el 'pasado'.

estan ampliados para buscar hasta la columna "EZ"

por otro lado te comento que si preves tener muchos registros quizas
sea un poco lento. Te comento mas o menos mis pruebas hechas con las
columnas de la "A" a la "DZ" llenas de datos:(131 columnas)

'bastante rapido'




estoy haciendo pruebas con filtros, que son mucho mas rapidos, pero
estoy atorado. Si preves miles de filas, comentalo y, si logro hacerme
con los filtros, que me suelen llevar por el camino de la amargura, te
lo envio.

un saludo y hasta pronto
Ivan

Los codigos-->
(por cierto, los otros llevaban bastante 'chatarra' que se me paso
quitar)
Sub CitasHoy()
Dim fiB As Integer, coB As Single
Dim lt As String, NoEsta As Boolean
Busca = False
With ActiveSheet
If .UsedRange.Columns.Count < 19 Then Exit Sub
Application.ScreenUpdating = False
.Rows.Hidden = False
For fiB = 1 To .[a65536].End(xlUp).Row
NoEsta = True
For coB = 19 To .UsedRange.Columns.Count Step 3
If coB < 27 Then
lt = Chr(64 + coB)
ElseIf coB > 26 And coB < 53 Then
lt = "a" & Chr(64 + (coB - 26))
ElseIf coB > 52 And coB < 79 Then
lt = "b" & Chr(64 + (coB - 52))
ElseIf coB > 78 And coB < 105 Then
lt = "c" & Chr(64 + (coB - 78))
ElseIf coB > 104 And coB < 131 Then
lt = "d" & Chr(64 + (coB - 104))
ElseIf coB > 130 And coB < 157 Then
lt = "e" & Chr(64 + (coB - 130))
End If
If .Range(lt & fiB) = Date Then
NoEsta = False: Exit For
End If
Next
.Range(lt & fiB).EntireRow.Hidden = NoEsta
Next
End With
Busca = True
Application.ScreenUpdating = True
End Sub


Sub MostrarTodo()
Dim Celda As Range
Application.ScreenUpdating = False
ActiveSheet.Rows.Hidden = False
Busca = False
Application.ScreenUpdating = True
End Sub


Sub BuscarPorFecha()
Dim fiB As Integer, coB As Single
Dim lt As String, NoEsta As Boolean
Dim Fecha As String
Busca = False
With ActiveSheet
If .UsedRange.Columns.Count < 19 Then Exit Sub
Application.ScreenUpdating = False
.Rows.Hidden = False
Fecha = InputBox("Escribe la fecha a buscar")
If Fecha = "" Then Exit Sub
For fiB = 1 To .[a65536].End(xlUp).Row
NoEsta = True
For coB = 19 To .UsedRange.Columns.Count Step 3
If coB < 27 Then
lt = Chr(64 + coB)
ElseIf coB > 26 And coB < 53 Then
lt = "a" & Chr(64 + (coB - 26))
ElseIf coB > 52 And coB < 79 Then
lt = "b" & Chr(64 + (coB - 52))
ElseIf coB > 78 And coB < 105 Then
lt = "c" & Chr(64 + (coB - 78))
ElseIf coB > 104 And coB < 131 Then
lt = "d" & Chr(64 + (coB - 104))
ElseIf coB > 130 And coB < 157 Then
lt = "e" & Chr(64 + (coB - 130))
End If
If .Range(lt & fiB) = CDate(Fecha) Then
NoEsta = False: Exit For
End If
Next
.Range(lt & fiB).EntireRow.Hidden = NoEsta
Next
End With
Busca = True
Application.ScreenUpdating = True
End Sub

Disculpa la demora, pero he estado de viaje.

He probado con tu ultimo post y es perfecto. He conseguido solventar las dos
dudas que te planteaba.

Muchas Gracias