user form is not displayed with some extra lines of code - excel

Why does the userform (a barcode) not show up with this code (only timer is running):
Sub Barcode_Show()
'show barcode form
On Error GoTo Errorhandler
Application.OnTime Now, "Barcode_Close"
DoEvents
Load form_Barcode
With form_Barcode
.Barcode128 = rngTarget.Value
**If ActiveSheet.CodeName = wsPastorer Then
.BarcodeLabel = "P" & TankCell.Value & " - " & ProduktCell.Value
Else
.BarcodeLabel = "T" & TankCell.Value & " - " & ProduktCell.Value
End If**
.Show
End With
Exit Sub
Errorhandler:
Call Barcode_Close
End Sub
When I change it to
DoEvents
Load form_Barcode
With form_Barcode
.Barcode128 = rngTarget.Value
.BarcodeLabel = "T" & TankCell.Value & " - " & ProduktCell.Value
.Show
End With
it will work.
I tried to have some other code in that place before, and it didn't work either. Why is it not possible and how to write the code so the form will show?

Related

Ctrl + Page Up / Page Down not compatible with UserForm featuring refEdit

I created an "Index Match Wizard" using UserForm controls. The code works effectively, however, I am unable to use ctrl + pgup / pgdn while the userform is running. No other shortcuts appear to be unavailable. The requirement to use a mouse to click to a different tab largely eliminates the purpose of the macro.
My code is as follows:
Sub UserForm_Initialize()
ListBox1.AddItem "Exact"
ListBox1.AddItem "Approx."
End Sub
Sub CommandButton1_Click()
MatchRangeOne = RefEdit1.Value
MatchRangeTwo = RefEdit2.Value
IndexRange = RefEdit3.Value
If ListBox1.Value = "Approx." Then
ActiveCell.Formula = "=INDEX(" & RefEdit3.Value & ",MATCH(" & RefEdit1.Value & "," & RefEdit2.Value & ",1))"
Else
ActiveCell.Formula = "=INDEX(" & RefEdit3.Value & ",MATCH(" & RefEdit1.Value & "," & RefEdit2.Value & ",0))"
End If
Unload IndexMatchWizardForm
End Sub

Multi-optional macros using removeable checkboxes

Thanks to these instructions
How do I assign a Macro to a checkbox dynamically using VBA
https://social.msdn.microsoft.com/Forums/office/en-US/877f15da-bbe4-4026-8ef2-8df77e1022f7/how-do-i-assign-a-macro-to-a-checkbox-dynamically-using-vba?forum=exceldev
I came up with an idea to:
Put checkboxes where I want on the sheet, e.g. in columns to the right from table with data for processing
Connect their (un)checking with logical variables which are used whether to start or not to start some procedures.
Wait for user to make his choices and check certain checkbox (e.g. the last in the list) to start selected procedures
Remove all (!) checkboxes and start the procedures selected shortly before.
This way the macros containing optional procedures are portable, as they don't DEPEND on the opened files but only WORK on them.
The files themselves remain unchanged by these free from control buttons coded in the macro (i.e. the sheet with checkboxes returns to it's previous state).
The following macro makes its own checkboxes (in column H), waits for user to choose options, memorizes choices, deletes all checkboxes, runs other procedures... and ends up without leaving a trace of itself in a workbook.
Dim FirstOptionLogical, SecondOptionLogical, ThirdOptionLogical As Boolean
' Making new checkboxes
Sub CheckBOxAdding()
Dim i As Long, id As Long
Dim cel As Range
Dim cbx As CheckBox
On Error GoTo CheckBoxAddingERROR
'FirstOptionLogical = False
'SecondOptionLogical = False
'ThirdOptionLogical = False
' Deleting all checkboxes, if any found
' Preventing error stops if there is no checkbox
On Error Resume Next
' Repeating with all checkboxes on active sheet
For Each chkbx In ActiveSheet.CheckBoxes
' Removing a checkbox
chkbx.Delete
' Next checkbox
Next
Range("G3").Select
ActiveSheet.Range(Columns("G:G"), Selection.End(xlToRight)).Select
Selection.Delete Shift:=xlToLeft
On Error GoTo 0
Set cel = ActiveSheet.Cells(3, 8)
With cel
Set cbx = ActiveSheet.CheckBoxes.Add(.Left, .Top, 90, 3)
' height will autosize larger to the font
End With
cbx.Name = "Option_1"
cbx.Caption = "First Attribute changes, name it"
cbx.Display3DShading = True
' with a linked can trap sheet change event or link to other formulas
cbx.LinkedCell = cel.Offset(0, -1).Address
cbx.OnAction = "'" & ThisWorkbook.Name & "'!CheckBoxHandling"
''''''''''
Set cel = ActiveSheet.Cells(5, 8)
With cel
Set cbx = ActiveSheet.CheckBoxes.Add(.Left, .Top, 90, 3)
' height will autosize larger to the font
End With
cbx.Name = "Option_2"
cbx.Caption = "Second Attribute changes, name it"
cbx.Display3DShading = True
' with a linked can trap sheet change event or link to other formulas
cbx.LinkedCell = cel.Offset(0, -1).Address
cbx.OnAction = "'" & ThisWorkbook.Name & "'!CheckBoxHandling"
Set cel = ActiveSheet.Cells(7, 8)
With cel
Set cbx = ActiveSheet.CheckBoxes.Add(.Left, .Top, 90, 3)
' height will autosize larger to the font
End With
cbx.Name = "Option_3"
cbx.Caption = "Third Attribute changes, name it"
cbx.Display3DShading = True
' with a linked can trap sheet change event or link to other formulas
cbx.LinkedCell = cel.Offset(0, -1).Address
cbx.OnAction = "'" & ThisWorkbook.Name & "'!CheckBoxHandling"
Set cel = ActiveSheet.Cells(9, 8)
With cel
Set cbx = ActiveSheet.CheckBoxes.Add(.Left, .Top, 90, 3)
' .Font.Size = 36
' height will autosize larger to the font
End With
cbx.Name = "Option_4"
cbx.Caption = "START THE MACRO"
cbx.Display3DShading = True
' with a linked can trap sheet change event or link to other formulas
cbx.LinkedCell = cel.Offset(0, -1).Address
cbx.OnAction = "'" & ThisWorkbook.Name & "'!CheckBoxHandling"
Exit Sub
CheckBoxAddingERROR:
MsgBox "Something went wrong... ;-) in the sub CheckBOxAdding", vbCritical + vbOKOnly
End
End Sub
Sub CheckBoxHandling()
Dim sCaller, UsersChoice As String
Dim id As Long
Dim cbx As CheckBox
Dim shp As Shape
UsersChoice = ""
On Error GoTo CheckBoxHandlingERROR
sCaller = Application.Caller
Set shp = ActiveSheet.Shapes(sCaller)
Set cbx = ActiveSheet.CheckBoxes(sCaller)
id = Val(Mid$(sCaller, Len("Option_") + 1, 5))
' maybe something based on Select Case?
Select Case id
Case 1:
'MsgBox "You clicked the checkbox with option" & vbCrLf & "'Larger description of First Attribute changes, name it'"
FirstOptionLogical = Not FirstOptionLogical
'FirstOptionLogical = IIf(cbx.Value = xlOn, True, False)
'MsgBox "FirstOptionLogical = " & FirstOptionLogical & vbCrLf & "SecondOptionLogical = " & SecondOptionLogical & vbCrLf & "ThirdOptionLogical= " & ThirdOptionLogical
Case 2:
'MsgBox "You clicked the checkbox with option" & vbCrLf & "'Larger description of Second Attribute changes, name it'"
SecondOptionLogical = Not SecondOptionLogical
'SecondOptionLogical = IIf(cbx.Value = xlOn, True, False)
'MsgBox "FirstOptionLogical = " & FirstOptionLogical & vbCrLf & "SecondOptionLogical = " & SecondOptionLogical & vbCrLf & "ThirdOptionLogical= " & ThirdOptionLogical
Case 3:
'MsgBox "You clicked the checkbox with option" & vbCrLf & "'Larger description of Third Attribute changes, name it'"
ThirdOptionLogical = Not ThirdOptionLogical
'ThirdOptionLogical = IIf(cbx.Value = xlOn, True, False)
'MsgBox "FirstOptionLogical = " & FirstOptionLogical & vbCrLf & "SecondOptionLogical = " & SecondOptionLogical & vbCrLf & "ThirdOptionLogical= " & ThirdOptionLogical
Case 4:
If FirstOptionLogical Then
UsersChoice = UsersChoice & "- Larger description of First Attribute changes, name it " & vbCrLf
End If
If SecondOptionLogical Then
UsersChoice = UsersChoice & "- Larger description of Second Attribute changes, name it " & vbCrLf
End If
If ThirdOptionLogical Then
UsersChoice = UsersChoice & "- Larger description of Third Attribute changes, name it " & vbCrLf
End If
Ans0 = MsgBox("The following options were chosen:" & vbCrLf & UsersChoice & vbCrLf & vbCrLf & _
"You chose a checkbox with an option" & vbCrLf & "'START THE MACRO'" & vbCrLf & vbCrLf & " S H O U L D W E S T A R T T H E M A C R O ? ", vbYesNo + vbDefaultButton2 + vbQuestion)
If Ans0 = vbYes Then
'MACRO WITH PARAMETERS WE CHOSE BY CLICKING GETS STARTED...
' Delete all remaining checkboxes, if any (removing traces of the macro)
' In case of error, resume
On Error Resume Next
For Each chkbx In ActiveSheet.CheckBoxes
chkbx.Delete
Next
' Deleting all columns from G to the right
Range("G3").Select
ActiveWorkbook.Sheets(1).Range(Columns("G:G"), Selection.End(xlToRight)).Select
Selection.Delete Shift:=xlToLeft
' Resetting on Error event to default
On Error GoTo 0
' If chosen, start sub 'Larger description of First Attribute changes, name it'
If FirstOptionLogical Then Call RunFirstOptionSub ' Name of the Sub
' If chosen, start sub 'Larger description of Second Attribute changes, name it'
If SecondOptionLogical Then Call RunSecondOptionSub ' Name of the Sub
' If chosen, start sub 'Larger description of Third Second Attribute changes, name it'
If ThirdOptionLogical Then Call RunThirdOptionSub ' Name of the Sub
Else
If Ans0 = vbNo Then
End If
End If
Exit Sub
End Select
cbx.TopLeftCell.Offset(, 2).Interior.Color = IIf(cbx.Value = xlOn, vbGreen, vbRed)
'MsgBox cbx.Caption & vbCr & IIf(cbx.Value = xlOn, " is ", " is not ") & "chosen"
Exit Sub
CheckBoxHandlingERROR:
MsgBox "Something went wrong... ;-) in the Sub CheckBoxHandling", vbCritical + vbOKOnly
End Sub
Sub RunFirstOptionSub()
' CODE
End Sub
Sub RunSecondOptionSub()
' CODE
End Sub
Sub RunThirdOptionSub()
' CODE
End Sub
Sub MacroWithOptionsEndsWithoutATrace()
FirstOptionLogical = False
SecondOptionLogical = False
ThirdOptionLogical = False
' OPTIONAL: Delete all remaining checkboxes, if any (most important when testing macro)
On Error Resume Next
For Each chkbx In ActiveSheet.CheckBoxes
chkbx.Delete
Next
' Resetting on Error event to default
On Error GoTo 0
CheckBOxAdding
End Sub
Share and use as you wish, as I used other's knowledge and experience.
I am very sorry, but I haven't found any other solution to present this to you, and I also haven't found anyone else presenting something similar to this.
Updated on Dec 17th 2019:
You could also use these checkboxes even easier way: write a macro that
creates a blank worksheet somewhere After:=Sheets(Sheets.Count) , so that it now becomes the new "last sheet",
put there these checkboxes,
check/uncheck them and start the macro by clicking the lowest one of them,
delete this last worksheet, leaving no traces of macro
That way you won't have to think again about where to put temporary checkboxes...
Updated on Oct 7th 2020:
I finally assumed, it would be better to make this an answered question, since it is.

VBA Excel: Freeze when add Auto Save line

I have a code which checks "before save" event whether user fill mandatory cells.
When I tried to add additional line for give file to an automated name, code freezes. Yet create the file. Below you can find my code, most of the code is just checking the cells, but I'm not sure the reason of error, so I'm adding all of it in case there's something I missed.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim message As String
Dim say As Long
say = Application.WorksheetFunction.CountA(Worksheets("ACC REQ").Range("C:C"))
If Application.WorksheetFunction.CountA(Worksheets("ACC REQ").Range("D:D")) <> say Then
message = Range("D1").Value & vbCrLf
End If
If Application.WorksheetFunction.CountA(Worksheets("ACC REQ").Range("F:F")) <> say Then
message = message & Range("F1").Value & vbCrLf
End If
If Application.WorksheetFunction.CountA(Worksheets("ACC REQ").Range("G:G")) <> say Then
message = message & Range("G1").Value & vbCrLf
End If
If Application.WorksheetFunction.CountA(Worksheets("ACC REQ").Range("H:H")) <> say Then
message = message & Range("H1").Value & vbCrLf
End If
If Application.WorksheetFunction.CountA(Worksheets("ACC REQ").Range("I:I")) <> say Then
message = message & Range("I1").Value & vbCrLf
End If
If Application.WorksheetFunction.CountA(Worksheets("ACC REQ").Range("J:J")) <> say Then
message = message & Range("J1").Value & vbCrLf
End If
If Application.WorksheetFunction.CountA(Worksheets("ACC REQ").Range("K:K")) <> say Then
message = message & Range("K1").Value & vbCrLf
End If
If Application.WorksheetFunction.CountA(Worksheets("ACC REQ").Range("M:M")) <> say Then
message = message & Range("M1").Value & vbCrLf
End If
If Application.WorksheetFunction.CountA(Worksheets("ACC REQ").Range("N:N")) <> say Then
message = message & Range("N1").Value & vbCrLf
End If
If Application.WorksheetFunction.CountA(Worksheets("ACC REQ").Range("Q:Q")) <> say Then
message = message & Range("Q1").Value & vbCrLf
End If
If Application.WorksheetFunction.CountA(Worksheets("ACC REQ").Range("R:R")) <> say Then
message = message & Range("R1").Value & vbCrLf
End If
If Application.WorksheetFunction.CountA(Worksheets("ACC REQ").Range("AU:AU")) <> say Then
message = message & Range("AU1").Value & vbCrLf
End If
If message <> "" Then
MsgBox "" & message & vbCrLf & "Can’t Save with Empty Cells!!"
Cancel = True
End If
ThisFile = Format(Now(), "yyyy-mm-dd") & "__" & "ACC__" & Range("H2").Value & "__" & "CR"
ActiveWorkbook.SaveAs Filename:=ThisFile & ".xlsx"
End Sub
regards
Solution:
Put Cancel=True at the end of the procedure to keep Excel from freezing due to an infinite loop.
When you save the file, the Workbook_BeforeSave event runs *before Excel saves the file** like it normally would.
This can be prevented with Cancel=True, which is necessary in this case since you want to SaveAs it yourself.
Without Cancel=True, your SaveAs is triggered the Workbook_BeforeSave event again, where you SaveAs again which triggers the Workbook_BeforeSave event again....etc....
Alternative (more compressed):
Your code should work with the change above, but below is a way to compress the code further by removing repetition. (See also, how to create a Minimal, Complete, and Verifiable example.)
The size reduction is because of the use of With..End With and looping through a static array to avoid repeating the same code.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim msg As String, say As Long, ws As Worksheet, col
Set ws = Worksheets("ACC REQ")
With Application.WorksheetFunction
say = .CountA(ws.Columns("C"))
For Each col In Array("D","F","G","H","I","J","K","M","N","Q","R","AU")
If .CountA(ws.Columns(col))<>say Then msg=msg & Range(col & "1") & vbCrLf
Next col
Cancel = True 'we don't need Excel to save it
End With
If msg <> "" Then
MsgBox msg, , "Can't Save with Empty Cells!": Exit Sub
End If
ActiveWorkbook.SaveAs Format(Now(), "yyyy-mm-dd") _
& "__ACC__" & Range("H2") & "__CR.xlsx"
End Sub
This one took me a minute but I know what's the problem! You have an Event that is called BeforSave in which you save. Which means that you have the Event within it self. This causes an infinite loop.
Do this:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.EnableEvents = False
Dim message As String
Dim say As Long
Dim ThisFile As String
Dim Path As String
'.. Check stuff ..
Path = "C:\YourPath\YourFolder\"
ThisFile = Format(Now(), "yyyy-mm-dd") & "__" & "ACC__" & Range("H2").Value & "__" & "CR"
ThisWorkbook.SaveAs Filename:=ThisFile & ".xlsm"
Application.EnableEvents = True
Cancel = True
End Sub
This should solve your problems as it disables the events for the duration of the actual saving. Make sure that you have the Application.EnableEvents=True otherwise it will not fire at all.

Run-time error '1004': SaveAs Method of object '_Workbook failed

I'm using the following code to save an updated workbook.
Private Sub cmdSaveUpdatedWB_Click()
On Error GoTo Err_cmdSaveUpdatedWB_Click
gwbTarget.Activate <<<<<<<<<<<<<<<<<<<<<<<
Application.DisplayAlerts = False
gwbTarget.SaveAs txtUpdWorkbookName.Value, FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.DisplayAlerts = False
frmLoanWBMain.Show
gwbTarget.Close
Set gwbTarget = Nothing
gWBPath = ""
gWBName = ""
lblWorkbookSaved.Enabled = True
cmdUpdateAnotherWorkbook.Visible = True
Exit_cmdSaveUpdatedWB_Click:
Exit Sub
Err_cmdSaveUpdatedWB_Click:
MsgBox "The following error occurred inthe [cmdSaveUpdateWB_Click] event handler." & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & "Error descriptioin: " & Err.Description
Resume Exit_cmdSaveUpdatedWB_Click
End Sub
As noted in the title, the SaveAs operation fails. I've determined that the failure is a result of having the workbook to be saved losing the focus. I can step through the code and get the error. Once the error is generated, selecting Debug in the error message box and then pressing F5 to run the code will result in the workbook saving correctly. Placing Debug.Print statements before and after the Activate method of the worbook to be saved indicates that the active wokbook is the workbook containing the code and the form used to update the workbook. Placing a print statement in the Immediate wondow that prints the ActiveWorkbook.Name will result in printing the name of the workbook to be saved - gwbTarget.Name. Pressing F5 then runs the code correctly.
I have been unable to figure out why the workbook to be saved loses the focus. I placed delays, multiple activation statements, local variables to use for the workbookto be saved, and for the name of the workbook to be saved. Any help or ideas as to why this is happening and how to fix it will be greatly appreciated.
I did make some changes. The code is listed below...
Private Sub cmdSaveUpdatedWB_Click()
On Error GoTo Err_cmdSaveUpdatedWB_Click
Dim wbSave As Workbook
Set wbSave = gwbTarget
gwbTarget.Activate
Application.DisplayAlerts = False
''''''' gwbTarget.SaveAs txtUpdWorkbookName.Value, FileFormat:=xlOpenXMLWorkbookMacroEnabled
wbSave.SaveAs fileName:=txtUpdWorkbookName.Value, FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.DisplayAlerts = False
frmLoanWBMain.Show
gwbTarget.Close
Set gwbTarget = Nothing
gWBPath = ""
gWBName = ""
lblWorkbookSaved.Enabled = True
cmdUpdateAnotherWorkbook.Visible = True
Exit_cmdSaveUpdatedWB_Click:
Set wbSave = Nothing
Exit Sub
Err_cmdSaveUpdatedWB_Click:
MsgBox "The following error occurred inthe [cmdSaveUpdateWB_Click] event handler." & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & "Error descriptioin: " & Err.Description
Resume Exit_cmdSaveUpdatedWB_Click
End Sub
I've changed the code to more closely resemble the suggestion below. The listing is below, along with the variable definitions as they were upon entry into the program. The Excel code is running in a Citrix environment which may effect timing but shouldn't have any other effect on code execution.
I deleted the other code versions for brevity. The following code is what has worked. The key issue is that the workbook to be saved must be the active workbook when the SaveAs method is invoked.
Private Sub cmdSaveUpdatedWB_Click()
On Error GoTo Err_cmdSaveUpdatedWB_Click
Dim wbSave As Workbook
Dim wsActive As Worksheet
Dim sNWBName As String
Application.DisplayAlerts = False
sNWBName = txtUpdWorkbookName.Value
Set wbSave = gwbTarget
wbSave.Activate
Set wsActive = wbSave.ActiveSheet
wbSave.SaveAs fileName:=sNWBName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.DisplayAlerts = True
frmLoanWBMain.Show
gwbTarget.Close
Set gwbTarget = Nothing
gWBPath = ""
gWBName = ""
lblWorkbookSaved.Enabled = True
cmdUpdateAnotherWorkbook.Visible = True
Exit_cmdSaveUpdatedWB_Click:
Set wbSave = Nothing
Exit Sub
Err_cmdSaveUpdatedWB_Click:
Dim strErrMsg As String
strErrMsg = "Error Number: " & Err.Number & " Desc: " & Err.Description & vbCrLf & _
"Source:" & Err.Source & vbCrLf & _
"Updating Workbook: " & vbCrLf & " " & gwbTarget.Name & vbCrLf & _
"Selected Worksheet: " & gwsTrgSheet.Name & vbCrLf & _
"Active Workbook: " & vbCrLf & " " & ActiveWorkbook.Name & vbCrLf & _
"Worksheet: " & ActiveSheet.Name & vbCrLf & _
"Code Segment: cmdSaveUpdatedWB_Click event handler"
RecordErrorInfo strErrMsg
Resume Exit_cmdSaveUpdatedWB_Click
End Sub
Why don't you start with something like this
Private Sub cmdSaveUpdatedWB_Click()
Dim gwbTarget As Workbook
Set gwbTarget = Workbooks("workbook_name.xlsm") 'correct extension needed, workbook must be open
wb.SaveAs Filename:=gwbTarget.Path, FileFormat:=xlOpenXMLWorkbookMacroEnabled
MsgBox "Last saved: " & gwbTarget.BuiltinDocumentProperties("Last Save Time")
End Sub
Change one thing at a time to make it more like yours and hopefully it'll all work fine!
Update
As per the comments. If you are trying to open, update and close hundreds of workbooks. You can use this as a guide:
Sub ChangeWorkbooks()
Application.ScreenUpdating = False
Dim wbPaths As Range, wbSaveFilenames As Range
With Sheet1 'you will need to update this and the ranges below
Set wbPaths = .Range("A1:A650") 'including file extensions
Set wbSaveFilenames = .Range("B1:B650") 'including file extensions
End With
Dim i As Integer, totalBooks As Integer
Dim wbTemp As Workbook
totalBooks = wbPaths.Rows.Count
For i = 1 To totalBooks
Application.StatusBar = "Updating workbook " & i & " of " & totalBooks 'display statusbar message to user
Set wbTemp = Workbooks.Open(wbPaths.Cells(i, 1), False)
'make changes to wbTemp here
wbTemp.SaveAs wbSaveFilenames.Cells(i, 1)
wbTemp.Close
Next i
Set wbTemp = Nothing
Application.ScreenUpdating = True
Applicaton.StatusBar = False
End Sub

Excel Macro (save to Sharepoint Library) no longer accepting full stop?

Code is below which was working fine, now does not seem to like the ".xlsm" section. problem is on all PCs. I tried using the Filename= and a few variants and have pinned it down to "." (period) that it does not accept in ".xlsm", delete the period and it is fine but then lands in SharePoint as an unknown file (with no file extension). Any advice appreciated!
Sub SUBMIT()
Dim FName As String
FName = Range("E3").Text
FDate = Range("I3").Text
If Range("E3") = "" Then
MsgBox "Please Enter Your Name"
Range("E3").Select
ElseIf Range("I3") = "" Then
MsgBox "Please Enter Fortnight Ending Date"
Range("I3").Select
ElseIf Range("I3") <> "" Then
If MsgBox("Are you sure? (Have you entered your supervisor(s) and Fortnight End Date in the top panel ?", vbYesNo) = vbNo Then Exit Sub
ActiveWorkbook.SaveAs ("https://*****.sharepoint.com/corp/payroll/Timesheets" & FName & " " & FDate & " " & "Timesheet" & "xls")
MsgBox "Timesheet Submitted"
End If
End Sub
You should supply the file path without the extension and use the FileFormat parameter of the ActiveWorkbook.SaveAs() function.
In your case, you should change the row to this
ActiveWorkbook.SaveAs ("https://*****.sharepoint.com/corp/payroll/Timesheets" & FName & " " & FDate & " " & "Timesheet"), 52
The 52 I added at the end is the value for xlOpenXMLWorkbookMacroEnabled as described here
The code below works well for me on Win7 Excel2013
Sub StackOverflow()
ActiveWorkbook.SaveAs "C:\Temp\myfile", 52
End Sub

Resources