PDA

View Full Version : Message Boxes, Routines and how prevent Message boxes until an event happens



CotnRsk
01-27-2024, 07:31 PM
Hi, I'm new here. I have searched for answers and even used AI but I can't seem to get this solved. I have a ThisWorkbook routine that is called by date with a general vbInformation box. I click on ok and it calls a routine in a module to backup a directory. This is one of 4 macros with each told to place a check mark or else. Within that module I have a routine to place a check mark in a cell to visibly show that routine has been completed in case I need to cancel the backup routine and come back later. In this routine once the directory is created and folder contents copied and pasted I get a message box saying it's successful or one saying it failed if that the directory already exist. If succesfull a check mark is supposed to be placed before the success message and a new module is called. The problem is excel doesn't actually put the check mark in the cell until I either cancel the routine or let it go through all the other routines also called by module and though all modules run
successfully the last one fails because it doesn't see the check
marks until the routine is dies. Then if I run the last routine manually it says ok I see the marks. Anyone have any idea how I can make the marks visible before each success msg box and the next module is called? AI said I should declare wingdings so I did and it didn't help.

arnelgp
01-27-2024, 10:49 PM
maybe add DoEvents on your code.

Aussiebear
01-27-2024, 11:32 PM
Welcome to VBAX CotnRsk. Can you post your code/s so we can see what it is that you have written please?

Paul_Hossler
01-28-2024, 08:26 AM
Not sure I'm understanding the logic just from the description, but here's a simple example you can look at

Aussiebear
01-28-2024, 12:21 PM
Very nice Paul.

Paul_Hossler
01-29-2024, 07:22 AM
<blush>

Aussiebear
01-29-2024, 12:50 PM
Must admit I was so what puzzled at the description of the issue in post #1. Whilst working at the workbook level, needs a new directory and copy folder contents...?

Secondly, CotnRsk talks about Excel not seeing the Checkmark..., since only the OP knows the location of where the checkmark is meant to be placed, surely a check of the cell to see if it is not blank then call the next module if true may be his/her best intention.

BTW, I still like your approach.

CotnRsk
01-30-2024, 09:18 AM
Yes that is what I'm looking for. Just not sure how to implement it within the structure I have. Ill share my code but be forewarned its probably a mess to someone like you lol.

CotnRsk
01-30-2024, 09:55 AM
On ThisWorkbook I have:

Private Sub Workbook_Open()
Dim ReminderCell As Range
Set ReminderCell = Sheets("NewYearSetup").Range("I16")
If ReminderCell.value = "Done" Then
Exit Sub
End If
Call ShowReminder
End Sub

Private Sub ShowReminder()
Dim ReminderDate As Date
Dim StopDate As Date
ReminderDate = DateSerial(Year(Date), 1, 17) + TimeValue("08:23:00")
StopDate = DateSerial(Year(Date), + 1, 1) + TimeValue("00:00:00")
If Now > StopDateThen
Application.OnTime EarliestTime:=StopDate, Procedure:="StopReminder"
Else
Sheets("NewYearSetup").Select
MsgBox "Time to Backup", vbInformation, "Backup Directory"
Application.OnTime EarliestTime:=ReminderDate, Procedure:="ShowReminder"
End if
End Sub

Sub ShowReminder()
Dim Msg As String, Ans As Integer, FileName As String
Msg = "Happy New Years Eve" & vbCrLf & "Time to run the backup Script, would you like to continue"
Ans = MsgBox(Msg, vbYesNo, "Backup Reminder"
If Ans = vbYes Then
Sheets("NewYearSetup").Select
Application.Run "CreateFolder"
End If
End Sub

Sub CreateFolder()
Dim folderpath As String
Dim sourcePath As String
Dim destinationPath As String
Dim fso As Object
Dim objFolder As Object
Dim objFile As Object
Dim CheckMark As String
Dim ReminderCell As Range
If MsgBox("Your backup directory with be located message, click Yes to continue", vbYesNo, "Backup Directory") = vbNo Then Exist Sub
folderPath = "C:" & Worksheets("Personal").Range("A1").Value
If Dir(folderPath, vbDirectory) <> "" Then
MsgBox "A folder already exist with this name. Please delete or rename it and try again", vbInformation, "Folder Exist"
Exit Sub
Else
MkDir folderPath
sourcePath = "c:\directoryname"
destinationPath = "c:" & Worksheets("Personal").Range("A1").value
If Dir(destionationPath, vbDirectory) = "" Then
MkDir destionationPath
End If
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFolder = fso.Getfolder(sourcePath)
For Each objFile In objFolder.Files
fso.CopyFile objFile.Path, destionationPath & "" & objFile.name
Next objFile
For Each objSubFolder In objFolder.Subfolders
fso.CopyFolder objSubfolder.Path, destionationpath & "" & objSubFolder.name
Next objSubFolder
Set objFile = Nothing
Set objFolder = Nothing
Set fso = Nothing
End If
CheckMark = ""
On Error Resume Next
CheckMark = Worksheets("Sheets1").Range("A2").value
On Error Goto 0
Worksheets(("NewYearSetup").Range("M2").value = CheckMark
'This is the line AI said to put in there
Worksheets("NewYearSetup").Range("M2".Characters(Start:=1, Length:=1).Font.name = "WingDings" 'And its failing here as indicated with the yellow highlihght in the editor
If MsgBox("You have successfully backed up your directory." & vbCrLf & "Next you will capture other values" & vbCrLf & "Would you like to continue?", vbYesNo, " Backup Successful") = vbYes Then Application.Run "Module4.CaptureValues"
If CheckMark <> "" Then
Worksheets("NewYearSetup".Range("M2").value = CheckMark
Else
Worksheets("Sheets1").Range("B2").value = Worksheets("Sheet1".Range("B2").value
if Range("M2").value <> "" Then
Else
Exit Sub
End If
End If
End Sub

'Module4 sub
Sub CaptureValues(Optional ShowMessages = True)
Dim CheckMark As String
'The following code omitted because it just does some work for me
'Then
ActiveWorkbook.Save
ActiveWindow.Close
Sheets("NewYearSetup").Select
CheckMark = ""
On Error Resume Next
CheckMark = Worksheets("Sheet1).Range("A2").value
On Error Goto 0
If MsgBox("You have captured values. Next we need to clear some cells" & vbCrLf & " Proceed?", vbYesNo, "Captured Values" = vbYes Then Application.Run "Module5.ResetCells"
If CheckMark <> "" Then
Worksheets("NewYearSetup").Range("M6").value = CheckMark
Else
Worksheets("NewYearSetup").Range("M6").value = Worksheets("Sheets1").Range("B2").value
End If
End Sub

' And this continues a couple more times with each in their own module to be called with each checking for the CheckMark. When it gets to the last one I get the success message but a X which is in B2 of Sheets1 instead of the check mark, and it fails. If I manually run that module I get the success message and a check mark. What I seen in your sheet you sent me looks like what I need but since the code is so different Im not sure how to integrate it into what I have typed below. Im relatively new at this and really appreciate the guidance and support. Thanks for your time ~ David

Paul_Hossler
01-30-2024, 01:49 PM
It's a lot easier for others to test if you could include a WB as an attachment. That way we don't have to spent time creating one with your sheets, macros, forms, what nots



Worksheets("NewYearSetup").Range("M2").Characters(Start:=1, Length:=1).Font.name = "WingDings" 'And its failing here as indicated with the yellow highlihght in the editor


So i'm going to guess that you left the parentheses after "M2" off

CotnRsk
01-30-2024, 04:50 PM
It's a lot easier for others to test if you could include a WB as an attachment. That way we don't have to spent time creating one with your sheets, macros, forms, what nots



Worksheets("NewYearSetup").Range("M2").Characters(Start:=1, Length:=1).Font.name = "WingDings" 'And its failing here as indicated with the yellow highlihght in the editor


So i'm going to guess that you left the parentheses after "M2" off


You would be correct that is a typo here but is actually in that spot on the program. I don't even need it there for what I have accomplished I just included it since it was in my original statement here regarding AI. If I comment it out, the routines work. Im going to guess and say that what you are doing with .Cells().Value = Char(252) is how you are doing, what Im trying to accomplish, in the example you gave, but unfortunately, I can't include the WB for proprietary reasons. The routine im looking for help on is just a secondary routine that allows the users to cancel a process of 5 steps that sets the program back up for the new year using some helper cells to capture values and restore them. Basically, a checks and balance operation. I could provide the code for the last module in the series called so you could compare it against the other?

CotnRsk
01-30-2024, 05:00 PM
Sub TransferCaptpuredValues()
Dim CheckMark As String
Dim ReminderCell As Range
Set ReminderCell = Worksheets("NewYearSetup").range("I16")

If MsgBox("Ready to transfer those values?", vbYesNo, "Transfer Values") = vbNo Then Exit Sub

'Some stuff I have it do

ActiveWorkbook.Save
ActiveWindow.Close

Worksheets("NewYearSetup").Select
CheckMark = ""
On Error Resume Next
CheckMark = Worksheets("Sheets1").Range("A2").value
On Error Goto 0

If CheckMark <> "" Then

Worksheets("NewYearSetup").Range("M12").value = CheckMark
If Range ("M2").value <> "" And Range("M6").value "" And Range("M8").value And Range("M10").value <> "" And Range("M12").value <> "" Then
MsgBox "Congrats, you are ready for the new year", vbInformation, "Process Complete"

ReminderCell = "Done"

Else

Worksheets(("NewYearSetup").Range("m12").value = Worksheets("Sheets1").Range("B2").value

If Range("I16").value = "" Then MsgBox "The process is not complete. Check to see which one doesnt have a check mark and run that process first", vbInformation, "Incomplete"

End if
End if
End Sub

CotnRsk
01-30-2024, 05:05 PM
The routines works insomuch that If I forgo the check mark process I still get it to do what I want. I'm just attempting to give the user a way to know it ran that process already in case there is some level of distraction and I have a final cleanup process that removes the checkbox and the word Done and returns to them back to the Personal worksheet after saving it.

CotnRsk
01-31-2024, 11:21 AM
So no one wants to help with the data I can give?

Paul_Hossler
01-31-2024, 12:06 PM
From my post #10 --


It's a lot easier for others to test if you could include a WB as an attachment. That way we don't have to spend time creating one with your sheets, macros, forms, what nots

And there's still a LOT of missing information that would be useful

Like where do you want the checks, what are the 4 steps (subs) that get run, etc.

I've found that the easiest way to explain is an XLSM with the worksheetsm userforms, macros, enough data to show the issue, and what the desired result is

Like what does TransferCaptpuredValues() do and where does it get run? Why is it just stuck into a new post with no context?

CotnRsk
01-31-2024, 10:39 PM
Ok so you can't help me. I have given you enough data, and you obviously can tell what's going on, in my opinion you're just gaslighting here. Anyone besides Paul want to give it a shot?

Aflatoon
02-01-2024, 02:54 AM
Not especially, with that attitude. The only thing I will say is check for (more) typos near the error.

CotnRsk
02-01-2024, 06:19 AM
lol I'll go to some other forum before I play stupid games with egocentrics who later claim they're the victim like some radical feminist. I got zero time for that.

georgiboy
02-01-2024, 06:47 AM
I would like to remind you that members here also exist on the other forums, so please make sure to follow the rules on cross-posting. Additionally, it might be worth considering restricting your opinions on political views. I hope you have a great day!

Aussiebear
03-04-2024, 06:45 PM
Sorry CoTnRsK, but your attitude to those assisting you here is unacceptable. Please come back when you have learnt to be polite to others.