Current ProcessQuick Win videos are currently selected from a folder with a collection of videos which isn’t a good set up for mistake proofing. Storing all Quick Win videos in one folder presents too many opportunities to make a mistake. There are currently 13 items in this folder meaning there are 12 opportunities to make a mistake. As I make more Quick Win videos this folder will only grow larger! My process must change to eliminate the potential of making the same mistake again.
New ProcessGoing forward I will store each individual Quick Win video in their own folder eliminating the potential of publishing the wrong video. This may seem like more work but it isn’t with VBA. Here is the code I am using to standardize this new process. If you want to see more VBA code visit our Macros page!
'Leverage & Lean "Less Clicks, More Results" Sub NewQuickWin() ' Means variable is in use Dim FolderPath As String ' Dim FolderObj As Object ' Dim QuickWinTitle As String ' 'Insert a new Row in Excel Range("A3:N3").Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Selection.Clear 'Set Quick Win Title QuickWinTitle = InputBox("What is the title of this Quick Win video?", "New Quick Win") 'Populate Excel with values Cells(3, 1).Value = QuickWinTitle & " [Quick Win!!!]" Cells(3, 2).Value = "This a Quick Win video in 30 seconds or less. This video will show you how to " Cells(3, 3).Value = Date 'Set Folder Path FolderPath = "C:\Users\lever\Desktop\Leverage & Lean\Media\Videos\Quick Wins\" & QuickWinTitle 'Create a new Folder Application.ScreenUpdating = False Set FolderObj = CreateObject("Scripting.FileSystemObject") If FolderObj.FolderExists(FolderPath) Then Else FolderObj.CreateFolder (FolderPath) End If Application.ScreenUpdating = True 'Set Path hyperlink to video With ActiveSheet .Hyperlinks.Add Anchor:=.Range("E3"), _ Address:=FolderPath, _ ScreenTip:="", _ TextToDisplay:="Path" End With 'Finish with Formatting Range("A3:B3").Select With Selection .HorizontalAlignment = xlLeft End With Range("C3").Select With Selection .HorizontalAlignment = xlCenter End With Range("D3").Select With Selection .HorizontalAlignment = xlLeft End With Range("E3").Select With Selection .HorizontalAlignment = xlCenter End With ActiveSheet.Cells(1, 1).Select End Sub 'Stay AwesomeThis new macro is run with a Command Button to populate Excel with the new Quick Win information
An InputBox helps me populate the Title in the first cell.
This macro continues and populates the leading phrase of the video description. Next it creates a new folder to store the video for this Quick Win.