Macro que verifique si las fechas de la columna "B" ya están vencidas y si es así ejecute acciones
Tengo la siguiente situación. Tengo una hoja llamada "Pendientes". La fila 1 de dicha hoja tiene los encabezados de cada columna de la "A" hasta la "Q". Los datos comienzan desde la fila 2 en adelante. La columna "A" tiene registrada la fecha en que se registró cada fila. En la columna "B" está la fecha de la cita de cada cliente. La columna "F" el "ID" de cada cliente, en la columna "G" el nombre del cliente y en la columna "N" el motivo de la cita del cliente.
Mi idea es tener una macro que verifique fila a fila, la fecha actual con la fecha registrada en la columna "B". Si la fecha actual es mayor a la registrada en la columna "B" no haga nada y continúe con el siguiente registro (Es decir con la siguiente fila) y verifique lo mismo. Es decir que mientras la fecha actual sea mayor a la fecha registrada en la columna "B" no hace nada. Pero si encuentra que la fecha actual es menor o igual a la fecha registrada en la columna "B" de una fila, entonces me salga un msgbox diciendo: "El cliente [G] identificado con [F] debía haber asistido al día de hoy a una cita para [N]. Desea registrar el motivo del incumplimiento del cliente?" y aquí ponerlo con opción de "SI" o "NO". En caso que dé "NO" termina la macro. En caso de responda "SI" solicita en un cuadro de texto que explique los motivos y estos los registra en una hoja llamada "Motivos" a partir de la fila 2 en adelante de la siguiente manera: En la columna "A" el "ID" del cliente, en la columna "B" su nombre, en la columna "C" el motivo de la visita y en la columna "D" el motivo del incumplimiento. Una vez realizado esto, elimina a este cliente de la hoja "Pendientes" y termina la macro.
1 Respuesta
H o l a:
Te anexo la macro
Sub Pendientes()
'Por.Dante Amor
Set h1 = Sheets("Pendientes")
Set h2 = Sheets("Motivos")
For i = 2 To h1.Range("B" & Rows.Count).End(xlUp).Row
If h1.Cells(i, "B") <= Date Then
res = MsgBox("El cliente " & h1.Cells(i, "G") & _
", identificado con " & h1.Cells(i, "F") & _
", debía haber asistido al día de hoy " & _
"a una cita para " & h1.Cells(i, "N") & "." & vbCr & vbCr & _
"Desea registrar el motivo del incumplimiento del cliente?", _
vbQuestion & vbYesNo, "REVISIÓN DE PENDIENTES")
If res = vbYes Then
motivo = InputBox("Explique los motivos", "REVISIÓN DE PENDIENTES")
u = h2.Range("B" & Rows.Count).End(xlUp).Row + 1
h2.Cells(u, "A") = h1.Cells(i, "F")
h2.Cells(u, "B") = h1.Cells(i, "G")
h2.Cells(u, "C") = h1.Cells(i, "N")
h2.Cells(u, "D") = motivo
h1.Rows(i).Delete
End If
End If
Next
End Subs a l u d o s
Hola Dante
La macro funcionó bien en una parte, pero luego de que revisó los que cumplían la condición de la fecha aún sigue saliendo el mensaje pero con datos vacíos
Lo único raro que se me ocurre pensar es si eso tiene que ver por que yo tengo los datos en una hoja de excel en donde le di formato de tabla y que por eso tome las celdas vacías como si tuvieran datos, tu que opinas Dante y si es así, que solución le podremos dar dado a que ese formato va hasta la fila 1000
Como no veo tu hoja, pues es difícil saber cómo tienes los datos, las soluciones podrían ser:
1. Cambia la tabla a formato de rango.
2. No dejes filas vacías en la tabla, no es necesario, ya que cuando empiezas a escribir, en automático la tabla crece.
3. Te actualizo la macro:
Sub Pendientes()
'Por.Dante Amor
Set h1 = Sheets("Pendientes")
Set h2 = Sheets("Motivos")
For i = 2 To h1.Range("B" & Rows.Count).End(xlUp).Row
If h1.Cells(i, "B") <= Date And h1.Cells(i, "B") <> "" Then
res = MsgBox("El cliente " & h1.Cells(i, "G") & _
", identificado con " & h1.Cells(i, "F") & _
", debía haber asistido al día de hoy " & _
"a una cita para " & h1.Cells(i, "N") & "." & vbCr & vbCr & _
"Desea registrar el motivo del incumplimiento del cliente?", _
vbQuestion & vbYesNo, "REVISIÓN DE PENDIENTES")
If res = vbYes Then
motivo = InputBox("Explique los motivos", "REVISIÓN DE PENDIENTES")
u = h2.Range("B" & Rows.Count).End(xlUp).Row + 1
h2.Cells(u, "A") = h1.Cells(i, "F")
h2.Cells(u, "B") = h1.Cells(i, "G")
h2.Cells(u, "C") = h1.Cells(i, "N")
h2.Cells(u, "D") = motivo
h1.Rows(i).Delete
End If
End If
Next
End Subs a l u d o s
