VBA to save file with a different name and / or append suffixes based on conditions

[akshay27]

We have a list of criteria that are used to calculate a priority score for tickets that are created by various people. Originally, a single person was responsible for rating each ticket for various criteria in a single worksheet, based on which a priority score was calculated in a second worksheet in the same workbook. Now, three people need to rate each ticket, so now, the workbook has three worksheets (one per person), and the fourth worksheet calculates the score. I am trying to set up a VBA script that will allow each of us to work at our own pace and rate tickets as and when we can. Here's how I want it to work:

I start by opening the workbook called "Template.xlsm" which has the 4 sheets - "Combined Score", "AR", "MV", and "RP". In cell B1 of "Combined Score", I enter the ticket number (let's use "4025" as an example) which I am rating.

I go to a sheet with my initials (let's say "AR") and rate the ticket based on various criteria (standard check boxes linked to cells that toggle "True/False" values - nothing fancy here).

Then I click a "Save" ActiveX button on my sheet. This needs to trigger one macro:

If the currently open file is "Template.xlsm" (i.e. I am the first person to rate the ticket), then a copy of the file should be saved as "4025_AR" in the "\Prioritisation\In Progress" folder with the "AR" tab coloured Green.
If the file name has "4025" and "_AR" in the file name (i.e. I am either not the first person to rate the ticket or if I am editing my own ratings), then the file should be saved as "4025_AR" (and not "4025_AR_AR" or so) in the "\Prioritisation\In Progress" with the "AR" tab coloured Green.

The next person to put their ratings in, should ideally not use "Template.xlsm" but instead look in the "In Progress" folder to check if someone else has already finished rating the ticket they want to rate. If MV sees a file called "4025_AR", they should open that file instead of opening "Template.xlsm" and entering the ticket number again. I have no idea if there's any way to check for this using VBA. For now, I'm going to trust that all of us will check the folder first.

Once MV is done rating ticket 4025 in the "4025_AR" sheet, they click the "Save" ActiveX button on their sheet. Now, their worksheet's tab should be coloured green, the sheet should be saved with MV's initials in the file name, and the original sheet "4025_AR" should be deleted (because we don't want three copies of each sheet". Again, if MV decides to come back later and update their ratings, their initials should only appear once (the order doesn't matter - it could be "4025_MV_AR" or "4025_AR_MV" - just that one person's initials shouldn't be there more than once).

Once all three people have finished rating the ticket, then one of us can click the "Finalise" ActiveX button in the "Combined Score" sheet - this button should trigger a macro that will copy the "Combined Score" table as an image that we can paste inside the ticket, save the file as "4025" in the "\Prioritisation\Completed" folder, and delete the "4025_AR_MV_RP" file. However, this button should not work unless all three people have rated the ticket. It could either check the file name to see if all three initials are in, or it could check if all three tabs are coloured green, or any other kind of implementation that might be easier.

I've started working on some macros and implementing some of these ideas, but I don't know nearly enough to be able to put something this complex together. If someone has an easier logic for this entire workflow, I am completely open to ideas. This workflow is still just an idea and hasn't been set in stone as yet.

Here's what the Combined Score sheet looks like:

Priorisierung Checkliste 2.3 - Draft.xlsm
	A	B
1	Ticket ID	4032
2	Business + Customer Value inkl. Workaround	0
3
4	Business Value	0
5	Primäre Business Value Treiber:	Score
6	Betrifft mehrere Portale	0
7	Erfüllt unmittelbar die Unternehmensziele oder entspricht einer Forderung aus dem Wiener Tourismusförderungsgesetz	0
8	Erfüllt gesetzliche Anforderungen (Barrierefreiheit, Datenschutz)	0
9	Es besteht Gefahr in Verzug (z.B. sehr hohes Sicherheitsrisiko)	0
10	Ist Teil der Roadmap	0
11	Generiert Wettbewerbsvorteil	0
12	Summe Primäre Business Value	0
13	Sekundäre Business Value Treiber:	Score
14	Erhöht massiv Zufriedenheit bei intene Key Usern	0
15	Die Komplexität von Prozessen wird reduziert, Effizienz in der Backend-Anwendung erhöht (= Effizienz / Zeitgewinn im Gesamtablauf)	0
16	Erhöht massiv Zufriedenheit bei extene Stakeholdern	0
17	Erhöht die Modernität des Web-Auftritts (ist State-of-the-Art)	0
18	Erhöht Sicherheit (Information Security)	0
19	Entspricht den aus den Channel Zielen abgeleiteten Massnahmen aus der Channel Strategie	0
20	Schafft Konsistenz beim Markenauftritt und/oder stärkt die Emotionalisierung des Web-Auftritts	0
21	Resultiert aus Kooperationsvereinbarung	0
22	Summe Sekundäre Business Value	0
23
24	Customer Value	0
25	Customer Value Treiber:	Score
26	Erhöht Mehrwert für Endnutzer unmittelbar (statt “nur” Verbesserung des bestehenden Produkts)	0
27	Betrifft den Endnutzer mehrerer Portale	0
28	Die Usability für Endnutzer wird dramatisch erhöht	0
29	Die Komplexität von Prozessen für den Endnutzer wird reduziert	0
30	Erhöht dramatisch die Performance	0
31	Betrifft ein stark genutztes Feature	0
32	Trägt zur channel-übergreifenden Konsistenz bei	0
33	Summe Customer Value	0
34
35	Workaround Möglich?	Score
36	Workaround möglich, auch wenn nicht optimal	0
Combined Score

Cell Formulas
Range	Formula
A2	A2	=IF(B4>40,"Bitte Business Value Auswahl reduzieren", IF(B24>40, "Bitte Customer Value Auswahl reduzieren", "Business + Customer Value inkl. Workaround"))
B2	B2	=IF(OR(B4="😱",B24="😱"),"😱",SUM(B4,B24,WorkaroundCombined[Score]))
A4	A4	=IF(B4>40,"Bitte Business Value Auswahl reduzieren","Business Value")
B4	B4	=XLOOKUP(SUM(PrimaryBusinessValueCombined[[#Totals],[Score]],SecondaryBusinessValueCombined[[#Totals],[Score]]),Values[Linear Values],Values[Fibonacci Sequence],"😱")
B6:B11	B6	=MROUND( AVERAGE( IF(PrimaryBusinessValue_Person1[@Score]>0,PrimaryBusinessValue_Person1[@Score],0), IF(PrimaryBusinessValue_Person2[@Score]>0,PrimaryBusinessValue_Person2[@Score],0), IF(PrimaryBusinessValue_Person3[@Score]>0,PrimaryBusinessValue_Person3[@Score],0) ), 2)
B12,B33,B22	B12	=SUBTOTAL(109,[Score])
B14:B21	B14	=MROUND( AVERAGE( IF(SecondaryBusinessValue_Person1[@Score]>0,SecondaryBusinessValue_Person1[@Score],0), IF(SecondaryBusinessValue_Person2[@Score]>0,SecondaryBusinessValue_Person2[@Score],0), IF(SecondaryBusinessValue_Person3[@Score]>0,SecondaryBusinessValue_Person3[@Score],0) ), 1)
A24	A24	=IF(B24>40,"Bitte Customer Value Auswahl reduzieren","Customer Value")
B24	B24	=XLOOKUP(CustomerValueCombined[[#Totals],[Score]],Values[Linear Values],Values[Fibonacci Sequence],"😱")
B26:B32	B26	=MROUND(AVERAGE( IF(CustomerValue_Person1[@Score]>0,CustomerValue_Person1[@Score],0), IF(CustomerValue_Person2[@Score]>0,CustomerValue_Person2[@Score],0), IF(CustomerValue_Person3[@Score]>0,CustomerValue_Person3[@Score],0)), 1)
B36	B36	=MROUND(AVERAGE( IF(Workaround_Person1[@Score]>0,Workaround_Person1[@Score],0), IF(Workaround_Person2[@Score]>0,Workaround_Person2[@Score],0), IF(Workaround_Person3[@Score]>0,Workaround_Person3[@Score],0)), 1)

There's a "Finalise" ActiveX button with this VBA code:

Sub Copy_Click()
'
' Copy_Click Macro
' Copies the entire table as a Bitmap so you can easily paste it into the Task.
'
    Range("A1:B36").Select
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
End Sub

And here's what one of the sheets for the raters looks like:

Priorisierung Checkliste 2.3 - Draft.xlsm
	A	B	C
1			US Link
2		Business + Customer Value inkl. Workaround	0
3
4		Business Value	0
5	✔	Primäre Business Value Treiber:	Score
6	FALSE	Betrifft mehrere Portale	0
7	FALSE	Erfüllt unmittelbar die Unternehmensziele oder entspricht einer Forderung aus dem Wiener Tourismusförderungsgesetz	0
8	FALSE	Erfüllt gesetzliche Anforderungen (Barrierefreiheit, Datenschutz)	0
9	FALSE	Es besteht Gefahr in Verzug (z.B. sehr hohes Sicherheitsrisiko)	0
10	FALSE	Ist Teil der Roadmap	0
11	FALSE	Generiert Wettbewerbsvorteil	0
12		Summe Primäre Business Value	0
13	✔	Sekundäre Business Value Treiber:	Score
14	FALSE	Erhöht massiv Zufriedenheit bei interne Key Usern	0
15	FALSE	Die Komplexität von Prozessen wird reduziert, Effizienz in der Backend-Anwendung erhöht (= Effizienz / Zeitgewinn im Gesamtablauf)	0
16	FALSE	Erhöht massiv Zufriedenheit bei externe Stakeholdern	0
17	FALSE	Erhöht die Modernität des Web-Auftritts (ist State-of-the-Art)	0
18	FALSE	Erhöht Sicherheit (Information Security)	0
19	FALSE	Entspricht den aus den Channel Zielen abgeleiteten Massnahmen aus der Channel Strategie	0
20		Schafft Konsistenz beim Markenauftritt und/oder stärkt die Emotionalisierung des Web-Auftritts	0
21		Resultiert aus Kooperationsvereinbarung	0
22		Summe Sekundäre Business Value	0
23
24		Customer Value	0
25	✔	Customer Value Treiber:	Score
26	FALSE	Erhöht Mehrwert für Endnutzer unmittelbar (statt “nur” Verbesserung des bestehenden Produkts)	0
27	FALSE	Betrifft den Endnutzer mehrerer Portale	0
28	FALSE	Die Usability für Endnutzer wird dramatisch erhöht	0
29	FALSE	Die Komplexität von Prozessen für den Endnutzer wird reduziert	0
30	FALSE	Erhöht dramatisch die Performance	0
31	FALSE	Betrifft ein stark genutztes Feature	0
32	FALSE	Trägt zur channel-übergreifenden Konsistenz bei	0
33		Summe Customer Value	0
34
35	✔	Workaround Möglich?	Score
36	FALSE	Workaround möglich, auch wenn nicht optimal	0
AR

Cell Formulas
Range	Formula
C1	C1	=HYPERLINK(("https://redacted.atlassian.net/browse/redacted-"&'Combined Score'!$B$1),"US Link")
B2	B2	=IF(C4>40,"Bitte Business Value Auswahl reduzieren", IF(C24>40, "Bitte Customer Value Auswahl reduzieren", "Business + Customer Value inkl. Workaround"))
C2	C2	=IF(OR(C4="😱",C24="😱"),"😱",SUM(C4,C24,Workaround_Person1[Score]))
B4	B4	=IF(C4>40,"Bitte Business Value Auswahl reduzieren","Business Value")
C4	C4	=XLOOKUP(SUM(PrimaryBusinessValue_Person1[[#Totals],[Score]],SecondaryBusinessValue_Person1[[#Totals],[Score]]),Values[Linear Values],Values[Fibonacci Sequence],"😱")
C6:C11	C6	=IF([@✔]=TRUE,2,0)
C12,C33,C22	C12	=SUBTOTAL(109,[Score])
C14:C21,C26:C32	C14	=IF([@✔]=TRUE,1,0)
B24	B24	=IF(C24>40,"Bitte Customer Value Auswahl reduzieren","Customer Value")
C24	C24	=XLOOKUP(CustomerValue_Person1[[#Totals],[Score]],Values[Linear Values],Values[Fibonacci Sequence],"😱")
C36	C36	=IF([@✔]=TRUE,-5,0)

And these sheets have an ActiveX button with this code:

Sub Save_Click()
'
' Save Macro
' Export current worksheet with the ticket number and "_Current Worksheet Name" as a suffix.
'

Dim FilePath As String
Dim TicketID As String
Dim Suffix As String
Dim FileName As String

'Define the File Path as the "In Arbeit" folder in Sharepoint
FilePath = "P:\Priorisation\In Progress\"

'Define the Ticket Number from the Combined Score Sheet
TicketID = Sheets("Combined Score").Range("B1").Value

'Add Initials as a suffix
Suffix = "_" & ActiveSheet.Name

FileName = ActiveWorkbook.FileName

If ActiveSheet.Tab.Color = xlColorIndexNone Then

'Color the active Tab in green
ActiveSheet.Tab.Color = RGB(0, 175, 80)

'Save the Workbook with the Ticket Number & Initials in the "In Progress" Folder.
ActiveSheet.Select
    ActiveWorkbook.SaveAs FileName:= _
        FilePath & FileName & Suffix, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End If
'
End Sub

 

[akshay27]

Okay so a bit of an update here. I managed to write something that meets some of the conditions that I wanted it to hit, but there's still a ways to go.

Sub SaveButton()
'
' Save Macro
' Export current worksheet with the ticket number and "_Current Worksheet Name" as a suffix.
'
'========================
'0. Set up Variable Names
'========================
Dim FilePath As String
Dim FinalPath As String
Dim TicketID As String
Dim Suffix As String
Dim NewFileName As String
Dim Template As Boolean
Dim TemplateName As String
'=========================
'1. Define Variable Values
'=========================
'For the "FilePath" use the "Priorisation" folder
FilePath = "P:\Priorisation\Priorisation\"

'For the "FinalPath", use the the "Done" folder
FinalPath = "P:\Priorisation\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 = "Priorisation"

'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 "Priorisation" 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 "Priorisation" 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
'============================
Color the active Tab in green
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 Sub

I'm not yet sure how to get it to check if all three people have rated a ticket all that.