Buscar y dar mensaje si la fecha de hoy se encuentra en una hoja en diferentes celdas ?

Necesito una macro que al abrir el libro busque en una hoja ("parejas") en las columnas B, D, F, H, J, L, N y en las filas 11, 29,47 de cada columna mencionada. La fecha actual HOY. Si existe esa fecha indicar por msgBox  que está. Y volver ha realizar búsqueda hasta que revise todas las celdas indicadas. Si no está una vez revidadas las celdas salir de la macro.

1 Respuesta

Respuesta
1

Hice este código, que espero haga lo que necesites, para que funcione correctamente debes hacer lo siguiente:

  1. Abres el editor Visual Basic (VBA) con la tecla Alt+F11 o desde la ficha Programador en la cinta de opciones.
  2. Ubicas donde se encuentra el nombre de tu libro y en la carpeta Microsoft Excel Objetos, le das click en el signo + que esta de su lado izquierdo para que muestre su contenido (ver imagen). 

  3. Das doble click en Thisworkbook y se abrirá de tu lado izquierdo una pantalla en blanco, en esta copias el código completo tal y como está. Guardas el libro y lo cierras.
  4. Cuando lo vuelvas a abrir se ejecutará automáticamente y si no hay coincidencias no pasará nada, pero si en las celdas que mencionas hay una fecha igual que la de hoy, te enviará un mensaje donde te indica la celda en donde fué encontrada y continuará hasta revisar el resto. Si no pasa nada después es que ya no encontró otra coincidencia.
Private Sub Workbook_Open()
'Por Vico
Application.ScreenUpdating = False
Sheets("parejas").Select
Dim nRow, nCol, cnt As Integer
For cnt = 2 To 42 Step 2
    nRow = 11
    If cnt > 0 And cnt <= 14 Then
        If Cells(nRow, nCol + cnt) <> "" Then
            If Cells(nRow, nCol + cnt) = Date Then
                Cells(nRow, nCol + cnt).Select
                MsgBox "Se ha encontrado la fecha de hoy en la celda " & Cells(nRow, nCol + cnt).Address, vbInformation, "Coincidencia encontrada..."
            End If
        End If
    End If
    If cnt > 14 And cnt <= 28 Then
        nRow = 29
        If Cells(nRow, nCol + (cnt - 14)) <> "" Then
            If Cells(nRow, nCol + (cnt - 14)) = Date Then
                Cells(nRow, nCol + (cnt - 14)).Select
                MsgBox "Se ha encontrado la fecha de hoy en la celda " & Cells(nRow, nCol + (cnt - 14)).Address, vbInformation, "Coincidencia encontrada..."
            End If
        End If
    End If
    If cnt > 28 And cnt <= 42 Then
        nRow = 47
        If Cells(nRow, nCol + (cnt - 28)) <> "" Then
            If Cells(nRow, nCol + (cnt - 28)) = Date Then
                Cells(nRow, nCol + (cnt - 28)).Select
                MsgBox "Se ha encontrado la fecha de hoy en la celda " & Cells(nRow, nCol + (cnt - 28)).Address, vbInformation, "Coincidencia encontrada..."
            End If
        End If
    End If
Next cnt
End Sub

Espero que sea lo que necesitas, tu comentario es importante.

Víctor, de 10, excelente solución corre perfecto es lo que necesitaba, solo un pequeño problema que es un error mío, me equivoqué en cuanto las líneas iniciales nRow que son 12, 30, 48, que en un principio parece fácil cambiar pero entonces se me alteran los If cnt > ... y eso no encuentro su matemática. Si pudiera repararlo le estaría muy agradecido.

Pero su propuesta y la rapidez en solucionar son excelentes.

Aquí tienes el código nuevo, sólo reemplázalo y listo

Califica mi respuesta y cierra la pregunta, por favor.

Saludos... Víctor M.

Sub search_date()
Application.ScreenUpdating = False
Dim nRow, nCol, cnt As Integer
For cnt = 2 To 42 Step 2
    nRow = 12
    If cnt > 0 And cnt <= 14 Then
        If Cells(nRow, nCol + cnt) <> "" Then
            If Cells(nRow, nCol + cnt) = Date Then
                Cells(nRow, nCol + cnt).Select
                MsgBox "Se ha encontrado la fecha de hoy en la celda " & Cells(nRow, nCol + cnt).Address, vbInformation, "Coincidencia encontrada..."
            End If
        End If
    End If
    If cnt > 14 And cnt <= 28 Then
        nRow = 30
        If Cells(nRow, nCol + (cnt - 14)) <> "" Then
            If Cells(nRow, nCol + (cnt - 14)) = Date Then
                Cells(nRow, nCol + (cnt - 14)).Select
                MsgBox "Se ha encontrado la fecha de hoy en la celda " & Cells(nRow, nCol + (cnt - 14)).Address, vbInformation, "Coincidencia encontrada..."
            End If
        End If
    End If
    If cnt > 28 And cnt <= 42 Then
        nRow = 48
        If Cells(nRow, nCol + (cnt - 28)) <> "" Then
            If Cells(nRow, nCol + (cnt - 28)) = Date Then
                Cells(nRow, nCol + (cnt - 28)).Select
                MsgBox "Se ha encontrado la fecha de hoy en la celda " & Cells(nRow, nCol + (cnt - 28)).Address, vbInformation, "Coincidencia encontrada..."
            End If
        End If
    End If
Next cnt
End Sub

¡Gracias! Víctor

Mejora en la presentación de msgbox

¿Cuál es la mejora que necesitas?

Hola de nuevo Victor, en la macro que me hiciste he querido mejorar el msgBox con unos datos adicionales de unas celdas. en cuanto a la línea 12 me funciona correcto no así en la 30 y la 48 no logro que se ejecuten las dos últimas bien, a pesar de que he comprobado que la macro se posiciona correctamente me da otros datos de 14 columnas más adelante. te paso el msgBox de la línea 12 que si funciona haber que puedes hacer, gracias de antemano y saludos. pero no puedo enviar el código por este medio.

Si no es por este medio, ¿cómo lo vas a mandar? . Si me dices, cuales son las celdas con los valores a poner en el msgbox, con respecto a la celda que selecciona la macro, podría adaptar el código. Incluso lo que debe decir el mensaje.

Hola Victor es que no me deja colocar el mensaje en código, pero intento explicarme:

Una vez encuentre la coincidencia de fecha el msgbox tendría que dar la información que hay en la hoja "parejas",  así ("Pareja: " 11 celdas por encima) para la línea 12.  Para la 30  serian 28 filas por encima y para la 48  46 filas por encima además como segunda información  ("Anilla: " 2 celdas por encima) para la fila 12, 30, 48 y por último mostrar el contenido de la celda que está 1columna a la izquierda y 1 celda por encima  que en mi caso es Puesta 1 o Puesta 2 o Puesta 3. dependiendo de fila 12, 30, o 48 a ver si me he explicado. Gracias de antemano

Ya te hice un código, reemplaza el que tienes y prueba

https://drive.google.com/open?id=1NbGRmWyhscrQ6AD1-CAuaDyN44RsaHMz

Con respecto a este punto: " Para la 30 serian 28 filas por encima y para la 48 46 filas por encima"

Me parece que que ambas coinciden con la fila 2, así que tomarán el mismo valor.

OK. Victor ahora lo tienes, perfecto tan solo tuve que retocar el texto 4 pues con este código no funcionaba texto4= Selection..... 

por este otro Selection.Offset(-1, -1)  puesto que se quedaba en la primera selección.

Muchas gracias 

De nada, califícame y da por terminada tu pregunta

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas