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
Reply With Quote
Originally Posted by Paul_Hossler
