About 10 days ago, I started my first VBA project and posted to ask for help programming in a lot of logic that I had no idea how to even start with. Since then, I have managed to program in almost every single criterion I wanted as well as some fun extras. I have no experience in programming. Since this is the very first time I have put something like this together, I am wondering if there is a way to streamline all of this code and make it leaner and cleaner 
I have three VBA blocks, each perhaps with more comments than code mostly because I don't trust myself to remember what all of this means and why I did what I did a few months from now
The first bit triggers as soon as the workbook is opened and asks for a Ticket ID.
Then, one of the three people who need to rate the Jira Ticket can open their respective worksheets to rate the ticket, and click the "Save" button to trigger this Module
Once the last person has finished rating the ticket, they can click the "Finalise" button to trigger this module.
I do need some help in that last blip of code - while
I have three VBA blocks, each perhaps with more comments than code mostly because I don't trust myself to remember what all of this means and why I did what I did a few months from now
The first bit triggers as soon as the workbook is opened and asks for a Ticket ID.
VBA Code:
'========================
'0. Set up Variable Names
'========================
'Using Public intead of Dim here so that these variables can be accessed by various Subroutines
Public cellvalue As Variant
Public ws As Worksheet
'================================
'1. Check if US Number is entered
'================================
Sub Workbook_Open() 'This Subroutine will run as soon as the workbook is opened
Set ws = Worksheets("Combined Score") 'Every time something calls for "ws", it will reference the "Combined Score" Worksheet.
'If the Combined Score worksheet is renamed, then the name should be updated here as well.
cellvalue = ws.Range("B1").Value 'This will store whatever is in Cell B1 of whichever sheet is in "ws" in the "cellvalue" variable
If cellvalue = "" Or cellvalue = "0" Then 'We then check if cellvalue is blank or is a zero
Call TicketID_Input 'If it is, then we call the TicketID_Input subroutine (defined below)
End If
End Sub
'========================
'2. Ask for the US Number
'========================
Sub TicketID_Input()
'This subroutine will first display an input box & whatever is entered in that box will be stored in the variable "cellvalue"
'This step of the subroutine is labelled "ShowInputBox" so that we can jump to this specific step later on in the code
ShowInputBox: cellvalue = InputBox("Please enter the 4 digit User Story (US) Number", "Jira Ticket ID Required")
If cellvalue = "" Or cellvalue = "0" Then 'We check if "cellvalue" is blank or is a zero, just as before
'And if it is, then we display an error message. The Message Box will collect Information from the user with Yes & No buttons
'This information will be stored in a variable called "Response"
Response = MsgBox("Saving & Finalising this file is not possible without entering a User Story Number. Would you like to go back and enter a US Number now? " & vbNewLine & vbNewLine & _
"If you select 'No', the 'Ticket ID' will remain blank till you enter a US Number manually." & vbNewLine & vbNewLine & _
"Please remember to do so before you try saving otherwise, things might not work or they might break.", vbInformation + vbYesNo, "User Story Number not entered")
If Response = vbYes Then GoTo ShowInputBox 'If the user responds Yes, then we jump back to the "ShowInputBox" step (labelling that one was handy, right?)
Exit Sub 'And we skip the rest of the subroutine.
If Response = vbNo Then Exit Sub 'If the user responds no, then we skip the rest of the subroutine without jumping back or whatever.
End If
'We then check if "cellvalue" has anything other than numbers, and if it has numbers, we check if the numbers are less than 43 or greater than 5000
If Not IsNumeric(cellvalue) Or cellvalue < 43 Or cellvalue > 5000 Then
'If "cellvalue" is not numeric, or if it is numeric and is less than 43 or greater than 5000, we throw an error.
'As before, the message box collects information via Y/N buttons and stores it in a variable called "Response"
Response = MsgBox("This is not a valid US Number. Would you like to go back and enter a US Number now? " & vbNewLine & vbNewLine & _
"If you select 'No', the 'Ticket ID' will remain blank till you enter a US Number manually." & vbNewLine & vbNewLine & _
"Please remember to do so before you try saving otherwise, things might not work or they might break.", vbInformation + vbYesNo, "User Story Number not entered")
If Response = vbYes Then GoTo ShowInputBox 'And like before, if the user says yes, we jump back to our handy-dandy "ShowInputBox" step
Exit Sub 'And we skip the rest of the subroutine
If Response = vbNo Then Exit Sub 'If the user responds no, then we skip the rest of the subroutine.
'If cellvalue is indeed a number between 43 & 5000, then we change the Value of cell B1 in whatever worksheet is stored in "ws" to whatever is stored in "cellvalue"
Else: ws.Range("B1").Value = cellvalue
End If
Set cellvalue = Nothing 'Before we leave, we clean up & we clear whatever is stored in "cellvalue".
End SubThen, one of the three people who need to rate the Jira Ticket can open their respective worksheets to rate the ticket, and click the "Save" button to trigger this Module
VBA Code:
'========================
'0. Set up Variable Names
'========================
'Using Public instead of Dim here so that these variables can be accessed by various Subroutines
Public FilePath As String
Public FinalPath As String
Public TicketID As String
Public Suffix As String
Public NewFileName As String
Public Template As Boolean
Public TemplateName As String
Sub SaveButton()
'
' Save Macro
' Export current worksheet with the ticket number and "_Current Worksheet Name" as a suffix.
'
'=========================
'1. Define Variable Values
'=========================
'For the "FilePath" use the "In Arbeit" folder in Sharepoint
FilePath = "https://XXXX.sharepoint.com/sites/XXXX/In Progress/"
'For the "FinalPath", use the the "Vollständig Bewertet" folder in Sharepoint
FinalPath = "https://XXXX.sharepoint.com/sites/XXXX/Done/"
'For the "TicketID", use the Ticket Number that is entered manually in the Combined Score Sheet
TicketID = Sheets("Combined Score").Range("B1").Value
'For the "Suffix", use "_" and then the name of the current Worksheet (which should ideally be manually set to the rater's initials in the Template Sheet)
Suffix = "_" & ActiveSheet.Name
'For the "TemplateName", use a term that the template file name contains.
TemplateName = "Priorisierung"
'Figure out if the Template file is being used; the Template variable might seem pointless here, but will be important for simplifying logic later
If InStr(ActiveWorkbook.Name, TemplateName) Then 'If the name of the active workbook has "Priorisierung" in it, then obviously the template file is being used
Template = True 'So set that variable to true
NewFileName = TicketID 'And for the "NewFileName", use the "Ticket ID"
Else 'Otherwise, if the file name doesn't have "Priorisierung" in it, it isn't the template file i.e. it has already been rated by someone else
Template = False 'So set that variable to false
NewFileName = CreateObject("Scripting.FileSystemObject").GetBaseName(ActiveWorkbook.Name) 'And for the "NewFileName", use the current workbook's base name (i.e. without the file extension)
'If you include the file extension in the NewFileName, then the later steps will end up adding suffixes AFTER the file extension instead of before it.
End If
'============================
'3. Start the saving Process
'============================
'We first check if the Ticket ID has been entered.
If TicketID = "" Then 'If not, then we call the TicketID_Input function from ThisWorkbook
Response = MsgBox("Saving is not possible without a User Story Number." & vbNewLine & vbNewLine & _
"Please enter a US Number first, and then try saving afterwards." & vbNewLine & vbNewLine & _
"Would you like to enter a US Number now?", vbInformation + vbYesNo, "No User Story Number entered")
If Response = vbYes Then
Call ThisWorkbook.TicketID_Input
Exit Sub
Else: If Response = vbNo Then Exit Sub
End If
End If
'Color the active Tab in green so that whoever opens the file next time has a quick visual indicator of what all has been completed.
ActiveSheet.Tab.Color = RGB(0, 175, 80)
If Template = True Then 'If the template file is being used, then save the current file...
ActiveSheet.Select
ActiveWorkbook.SaveAs Filename:= _
FilePath & NewFileName & Suffix, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False '...in the FilePath with the NewFileName and the Suffix as a .xlsm file.
Else 'If it isn't the template file, then we go to the next check:
'If someone has already rated the file, then we need to check if someone is simply editing their ratings or if a new person is rating the file
'Otherwise, every time the same person edits their file and clicks save, their initials will be added to the file over and over agin again
'To check this, we use InStr - in the implementation below, it return the character position at which "Suffix" appears in the Active Workbook's Name
'e.g. in 4089_AR, if the active sheet is AR, InStr will look for "_AR" and it will return 5, because "_AR" appears after 4 characters (4089)
If InStr(ActiveWorkbook.Name, Suffix) <> 0 Then 'If this number is NOT zero, the filename contains the suffix already, which means that the person is probably editing their ratings
ActiveSheet.Select
ActiveWorkbook.Save 'In this case, the Workbook simply needs to be saved without changing the filename.
Else 'If InStr returns a 0, that means the suffix isn't in the filename, which means that this person hasn't entered their ratings as yet.
ActiveSheet.Select
ActiveWorkbook.SaveAs Filename:= _
FilePath & NewFileName & Suffix, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False 'So we go back to the same File Name logic as earlier.
End If
End If
End SubOnce the last person has finished rating the ticket, they can click the "Finalise" button to trigger this module.
VBA Code:
'========================
'0. Set up Variable Names
'========================
'Using Public intead of Dim here so that these variables can be accessed by various Subroutines
Public FilePath As String
Public FinalPath As String
Public TicketID As String
Public Suffix As String
Public NewFileName As String
Public Template As Boolean
Public TemplateName As String
Public NumberOfRaters As Integer
Public RequiredNumberOfRaters As Integer
Sub Finalise_Click()
'=========================
'1. Define Variable Values
'=========================
'For the "FilePath" use the "In Arbeit" folder in Sharepoint
FilePath = "https://XXXX.sharepoint.com/sites/XXXX/In Progress/"
'For the "FinalPath", use the the "Vollständig Bewertet" folder in Sharepoint
FinalPath = "https://XXXX.sharepoint.com/sites/XXXX/Done/"
'For the "TicketID", use the Value in Cell B1 of the Combined Score Sheet (which should ideally be the User Story Number)
TicketID = Sheets("Combined Score").Range("B1").Value
'For the "Suffix", use "_" and then the name of the current Worksheet (which should ideally be manually set to the rater's initials in the Template Sheet)
Suffix = "_" & ActiveSheet.Name
'For the "TemplateName", use a term that the template file name contains.
'This will be important for figuring out whether the template file is being edited, or if an already rated file is being edited.
TemplateName = "Priorisierung"
'Then, we need to figure out what the NewFileName will be.
'First, we check if the Template file is being used
If InStr(ActiveWorkbook.Name, TemplateName) Then 'If the name of the active workbook has whatever is stored in the "TemplateName" variable (above) in it, then obviously the template file is being used
Template = True 'So we set the variable "Template" to true. This variable might seem pointless here, but it will be important for simplifying logic later
NewFileName = TicketID 'And for the "NewFileName", use the "Ticket ID"
Else 'Otherwise, if the file name doesn't have whatever is stored in the "TemplateName" variable in it, it isn't the template file i.e. it has already been rated by someone else
Template = False 'So we set that variable to false
NewFileName = CreateObject("Scripting.FileSystemObject").GetBaseName(ActiveWorkbook.Name) 'And for the "NewFileName", use the current workbook's base name (i.e. without the file extension)
'If you include the file extension in the NewFileName, then the later steps will end up adding suffixes AFTER the file extension instead of before it
'(e.g.: 1234_AR.xlsm_DS_LP instead of 1234_AR_DS_LP.xlsm) ask me how I know >:[
End If
'We then need to count how many people have already rated the ticket or rather, the number of underscores in the file name ;P
'This is done by counting the Length of the Active Workbook's name and subtracting the length of the workbook's name after replacing all _ with blanks
NumberOfRaters = Len(ActiveWorkbook.Name) - Len(Replace(ActiveWorkbook.Name, "_", ""))
'At the moment, three people need to rate each ticket.
RequiredNumberOfRaters = 3
'=============
'2. Validation
'=============
'We first check if the Ticket ID has been entered.
If TicketID = "" Then 'If not, then we first throw an error.
'The error message collects information from the user via Yes / No buttons & stores that information in a variable called "Response"
Response = MsgBox("Finalising is not possible without a User Story Number." & vbNewLine & vbNewLine & _
"Please enter a US Number first, and then try Finalising afterwards." & vbNewLine & vbNewLine & _
"Would you like to enter a US Number now?", vbInformation + vbYesNo, "No User Story Number entered")
If Response = vbYes Then 'If the user responds yes,
Call ThisWorkbook.Workbook_Open 'We first call the Workbook_Open Subroutine from ThisWorkbook (Double Click "ThisWorkbook" on the left to see it)
Call Finalise_Click 'And then we run this entire subroutine from the beginning once again
Exit Sub 'And we skip the rest of the code
End If
If Response = vbNo Then 'If the user responds no, then we tell the user that nothing will happen.
MsgBox "Nothing has been copied, saved, or finalised." & vbNewLine & vbNewLine & _
"Please enter a US Number first, and then try Finalising again afterwards.", vbOKOnly, "No User Story Number entered"
Exit Sub 'And we skip the rest of the code
End If
End If
'Next, we check if this is the template file by checking if the "TemplateName" appears anywhere in the "String" that is the Active Workbook's name.
If InStr(ActiveWorkbook.Name, TemplateName) Then
MsgBox ("This is the Template File - nothing will be copied.") 'If it is indeed the template file, we don't do anything.
Exit Sub 'And we skip the rest of the code
Else 'Otherwise, if it is not the template file, then we proceed to check smoe more things
'We check if the "NumberOfRaters" is less than the "RequiredNumberOfRaters"
If NumberOfRaters < RequiredNumberOfRaters Then
MsgBox ("Someone still needs to rate this US - nothing will be copied.") 'If so, we throw an error and skip the rest of the code.
Else
If NumberOfRaters = RequiredNumberOfRaters Then 'If everyone has rated the file, then we start
'===============
'3. Finalisation
'===============
Range("A1:B36").Select 'Select cells A1 to B36
Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap 'Copy the selection as a Picure as it appears on the Excel Screen and as a Microsoft Excel Bitmap format image.
Call SaveFinal 'Call & run the SaveFinal Subroutine (defined below) - it's implemented like this so that making changes to just that one subroutine is a bit easier in the future.
'Once saved, display a popup message box called "Done!" with a success message, ask if the US should be opened & collect Information with Yes/No buttons.
'Which button the user presses should be saved in a variable called "Response"
Response = MsgBox("The file has been saved in the 'Done' Folder and the Report has been copied to your clipboard. Do you want to open the US?", vbInformation + vbYesNo, "Done!")
If Response = vbYes Then
ThisWorkbook.FollowHyperlink "https://XXXX.atlassian.net/browse/XXXXX-" & TicketID 'If the user clicks yes, then a a hyperlink should be followed from this workbook to the specified URL.
End If
'Then, display a popup called "Clean up" asking if the other files should be deleted, collect Information with Yes/No buttons, and store that info in a variable called "Response"
Response = MsgBox("Do you want the older files for Ticket ID " & TicketID & " in the 'In Arbeit' folder to be deleted automatically?", vbInformation + vbYesNo, "Clean up")
If Response = vbYes Then
Call DeleteIndividualRatings 'Call & run the DeleteIndividualRatings Subroutine (defined below) - it's implemented like this so that making changes to just that one subroutine is a bit easier in the future.
End If
End If
End If
End If
End Sub
'================
'4. Define Saving
'================
Sub SaveFinal()
ActiveSheet.Select 'Select the active sheet
ActiveWorkbook.SaveAs Filename:= _
FinalPath & TicketID, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False 'Save the workbook as .xlsm format file with the entire path + name being "FinalPath" plus "TicketID"
End Sub
'==================
'5. Define Deleting
'==================
Sub DeleteIndividualRatings()
'Define a bunch of local variables that we'll use only in this Subroutine
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim ws As Worksheet
'First we create a FileSystemObject so that we can assign it a folder.
'This is currently a big workaround and doesn't let the code work with Sharepoint, perhaps since this is an antiquated method that Microsoft created before Sharepoint existed? IDK
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Since we need to use an antiquated method to get the folder object where the files to be deleted are stored,
'The entire directory needs to be synced the user's local profile on the Company Laptop, from the Teams Channel.
'Unless this very specific requirement is met, the deletion will not work & very likely throw a "Path not found" error.
Set objFolder = objFSO.GetFolder(Environ("USERPROFILE") & "\XXXX\In Progress")
'Potential Solutions include:
'https://stackoverflow.com/questions/1344910/get-the-content-of-a-sharepoint-folder-with-excel-vba
'https://flylib.com/books/en/3.464.1.67/1/#:~:text=Delete%20the%20file%20from%20the%20SharePoint%20server
'For each file in the Folder object
For Each objFile In objFolder.Files
If InStr(1, objFile.Name, TicketID) > 0 Then 'We check if the TicketID is found in the name, delete the file
Kill objFile 'If we find such a file, then we Nuke it. Careful here - the Kill command doesn't put files into the Recycle bin! It basically pulls a Thanos!
'To Do - add yet another a confirmation that shows which files have been found & ask the user if those files really should be deleted.
'Perhaps throw them into the recycle bin for safety? Not sure if necessary though, since the final file has a record of everyone's ratings anyway.
End If
Next
'Clean up!
Set objFolder = Nothing
Set objFile = Nothing
Set objFSO = Nothing
End SubActiveWorkbook.SaveAs Filename:= works just fine when I specify a Sharepoint folder, FSO.GetFolder keeps throwing a "Path not found" error no matter how I write the Sharepoint path. I've implemented a workaround for the moment, but it assumes that the user has synced the Sharepoint folder to their system. I'd like to find a way to do this without needing the user to sync the folder.
