{"text_format":"1","workbook":"xlsx","n_sheets":2,"sheets":["Sheet1","code_fragments"],"not_rendered":{"charts":0,"images":0,"macros":1,"external_links":0,"defined_names":0,"comments":0,"pivot_tables":0},"unopened":[],"bounds":{"document_bytes":16777216,"sheet_cells":100000,"rows_first":2000,"rows_last":500,"rows_between":2000,"halvings":0,"cell_chars":16384,"cell_head_chars":4096},"cells_cut":0,"cells_raw":0,"read":"whole","date_system":"1900"}

{"sheet":"Sheet1","index":0,"n_rows":25,"n_cols":11,"rows_kept":25,"cut":false,"hidden":false,"merged":[[19,6,21,6],[19,0,21,0],[19,9,21,9]]}
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
[]
["Restore VBA Add-in",null,"VBA",null,null,null,"VBA Code Generator",null,null,"Get Excel Help!"]
[null,null,"Formulas",null,null,null,null,"Excel Boot Camp",null,null,"VBA Code Examples"]
[null,null,"Shortcuts",null,null,null,null,"Shortcut Coach",null,null,"About"]
["Restore",null,"Interactive Tutorials",null,null,null,"Premium Add-ins",null,null,"Help"]
[]
["icon = \"Restore\"",null,null,null,null,null,"icon = same as above",null,null,"icon = ? (same as above)"]

{"sheet":"code_fragments","index":1,"n_rows":191,"n_cols":3,"rows_kept":191,"cut":false,"hidden":true,"merged":[]}
["Columns and Rows","Autofit all Used Columns","\nSub AutofitAllUsed()\n\nDim x As Integer\n\nFor x = 1 To ActiveSheet.UsedRange.Columns.Count\n     Columns(x).EntireColumn.autofit\nNext x\n\nEnd Sub"]
[null,"Autofit Column","\nColumns(\"A:B\").EntireColumn.Autofit"]
[null,"Copy (Cut) and Paste One Column","\nSub PasteOneColumn()\n\n'Copy and Paste Column\nRange(\"A:A\").Copy Range(\"B:B\")\n'Cut and Paste Column\nRange(\"A:A\").Cut Range(\"B:B\")\n\nApplication.CutCopyMode = False\n\nEnd Sub"]
[null,"Copy (Cut) and Paste One Row","\nSub Paste_OneRow()\n\n'Copy and Paste Row\nRange(\"1:1\").Copy Range(\"2:2\")\n'Cut and Paste Row\nRange(\"1:1\").Cut Range(\"2:2\")\n\nApplication.CutCopyMode = False\n\nEnd Sub"]
[null,"Count Columns in Selection","\nPublic Sub CountMyColumns()\n\nMsgBox Selection.Columns.Count\n\nEnd Sub"]
[null,"Count Rows in Selection","\nPublic Sub CountMyRows()\n\nMsgBox Selection.Rows.Count\n\nEnd Sub"]
[null,"Delete Blank Rows","\nSub DeleteBlankRows()\nDim x As Long\n\nWith ActiveSheet\n    For x = .Cells.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1\n        If WorksheetFunction.CountA(.Rows(x)) = 0 Then\n            ActiveSheet.Rows(x).Delete\r\n        End If\r\n    Next\r\nEnd With\n\nEnd Sub\r\n"]
[null,"Delete Rows that Meet Certain Criteria","\nSub Delete_Rows(Data_range As Range, Text As String)\nDim Row_Counter As Integer\r\n\nFor Row_Counter = Data_range.Rows.Count To 1 Step -1\r\n    If Data_range Is Nothing Then\r Exit Sub\r\n    If UCase(Left(Data_range.Cells(Row_Counter, 1).Value, Len(Text))) = UCase(Text) Then\r\n         \t\tData_range.Cells(Row_Counter, 1).EntireRow.Delete\r\n    End If\r\nNext Row_Counter\r\n\r\nEnd Sub\r\n"]
[null,"Determine Start and End Column of Merged Cells","Public Sub StartEndMerge()\n\n'Declare Variables\nDim StartColumn As Integer\nDim EndColumn As Integer\n\n'Assign Variables\nStartColumn = ActiveCell.Column\nEndColumn = Selection.Columns.Count + StartColumn - 1\n\n'Show Results\nMsgBox \"Start Column \" & StartColumn\nMsgBox \"End Column \" & EndColumn\n\nEnd Sub"]
[null,"Do Something After Last Row","\nPublic Sub AfterLast()\n    ActiveSheet.Range(\"d\" & ActiveSheet.Rows.Count).End(xlUp).Offset(1, 0).Value = \"FirstEmpty\"\r\nEnd Sub\r\n"]
[null,"Find Last Column","\nSub LastCol()\n\nDim LastCol As Integer\nColRow = ActiveSheet.UsedRange.Col.Count\nMsgBox ColRow\n\nEnd Sub"]
[null,"Find Last Row","\nSub LastRow()\n\nDim LastRow As Integer\nLastRow = ActiveSheet.UsedRange.Rows.Count\nMsgBox LastRow\n\nEnd Sub"]
[null,"Find the Max Value in Each Column","\nFunction Max_Each_Column(Data_Range As Range) As Variant\nDim TempArray() As Double, i As Long\r\n\nIf Data_Range Is Nothing Then Exit Function\n\nWith Data_Range\n  ReDim TempArray(1 To .Columns.Count)\n\n  For i = 1 To .Columns.Count\n    TempArray(i) = Application.Max(.Columns(i))\n  Next\nEnd With\n\nMax_Each_Column = TempArray\n\nEnd Function\r\n"]
[null,"Get ActiveCell Column","\nPublic Sub ActiveColumn()\nMsgBox ActiveCell.Column\nEnd Sub"]
[null,"Get ActiveCell Row","\nPublic Sub ActiveRow()\nMsgBox ActiveCell.Row\nEnd Sub"]
[null,"Get Cell Column Letter","\nFunction Alpha_Column(Cell_Add As Range) As String\nDim No_of_Rows As Integer\r\nDim No_of_Cols As Integer\r\nDim Num_Column As Integer\r\n\nNo_of_Rows = Cell_Add.Rows.Count\r\nNo_of_Cols = Cell_Add.Columns.Count\r\n\nIf ((No_of_Rows <> 1) Or (No_of_Cols <> 1)) Then\r\n    Alpha_Column = \"\"\r\n    Exit Function\r\nEnd If\r\n\n Num_Column = Cell_Add.Column\r\n\nIf Num_Column < 26 Then\r\n    Alpha_Column = Chr(64 + Num_Column)\r\nElse\r\n    Alpha_Column = Chr(Int(Num_Column / 26) + 64) & Chr((Num_Column Mod 26) + 64)\r\nEnd If\r\n\nEnd Function\r\n"]
[null,"Loop Through an Entire Column","\nPublic Sub LoopColumn()\nDim c As Range\r\n\nFor Each c In Range(\"A:A\")\r\n\r\n    If c.Value = \"FindMe\" Then\r\n       MsgBox \"FindMe found at \" & c.Address\r\n    End If\r\n\r\nNext\n\nEnd Sub\r\n"]
[null,"Loop Through an Entire Row","\nPublic Sub LoopRow()\n\nDim c As Range\n\nFor Each c In Range(\"1:1\")\n\n    If c.Value = \"FindMe\" Then\n      MsgBox \"FindMe found at \" & c.Address\n    End If\n\nNext c\n\nEnd Sub "]
[null,"Scroll Column","\nActiveWindow.ScrollColumn = 5"]
[null,"Scroll Row","\nActiveWindow.ScrollRow = 5"]
[null,"Select Non-Contiguous Columns","\nSub SelectNon()\n\nRange(\"A:A,C:C,E:E,G:G\").Select\n\nEnd Sub"]
[null,"Set Column Width","\nSub Column_Width()\n\nColumns(\"A:E\").ColumnWidth = 30\n\nEnd Sub"]
[null,"Set Row Height","\nSub RowHeight()\nRows(\"1:1\").RowHeight = 30\r\n\nEnd Sub\r\n"]
[]
["Copy (Cut) and Paste","Copy (Cut) and Paste a Single Cell","\nSub Paste_OneCell()\n\n'Copy and Paste Single Cell\nRange(\"A1\").Copy Range(\"B1\")\n\n'Cut and Paste Single Cell\nRange(\"A1\").Cut Range(\"B1\")\n\nApplication.CutCopyMode = False\n\nEnd Sub"]
[null,"Copy (Cut) and Paste One Column","\nSub PasteOneColumn()\n\n'Copy and Paste Column\nRange(\"A:A\").Copy Range(\"B:B\")\n'Cut and Paste Column\nRange(\"A:A\").Cut Range(\"B:B\")\n\nApplication.CutCopyMode = False\n\nEnd Sub"]
[null,"Copy (Cut) and Paste One Row","\nSub Paste_OneRow()\n\n'Copy and Paste Row\nRange(\"1:1\").Copy Range(\"2:2\")\n'Cut and Paste Row\nRange(\"1:1\").Cut Range(\"2:2\")\n\nApplication.CutCopyMode = False\n\nEnd Sub"]
[null,"Copy (Cut) and Paste Range","\nSub Paste_Range()\n\n'Copy and Paste a Range of Cells\nRange(\"A1:A3\").Copy Range(\"B1:B3\")\n\n'Cut and Paste a Range of Cells\nRange(\"A1:A3\").Cut Range(\"B1:B3\")\n\nApplication.CutCopyMode = False\n\nEnd Sub"]
[null,"Copy (Cut) and Paste to Another Workbook","\nSub Paste_Other_Sheet_or_Book()\n\n'Cut or Copy and Paste to another worksheet\nWorksheets(\"sheet1\").Range(\"A1\").Copy Worksheets(\"sheet2\").Range(\"B1\") 'Copy\nWorksheets(\"sheet1\").Range(\"A1\").Cut Worksheets(\"sheet2\").Range(\"B1\") 'Cut\n\n'Cut or Copy and Paste to another workbook\nWorkbooks(\"book1.xlsm\").Worksheets(\"sheet1\").Range(\"A1\").Copy _ \nWorkbooks(\"book2.xlsm\").Worksheets(\"sheet1\").Range(\"B1\") 'Copy\nWorkbooks(\"book1.xlsm\").Worksheets(\"sheet1\").Range(\"A1\").Cut _ \nWorkbooks(\"book2.xlsm\").Worksheets(\"sheet1\").Range(\"B1\") 'Cut\n\nApplication.CutCopyMode = False\n\nEnd Sub"]
[null,"Copy (Cut) Selection","\nsub CopySelection() \n\n'Paste to a Defined Range\nselection.copy range(\"b1\")\n\n'Offset Paste (offsets 2 cells down and 1 to the right\nselection.copy\nselection.offset(2,1).paste\n\nend sub"]
[null,"Copy and Paste Special","\nSub PasteSpecial()\n\n'Perform one Paste Special Operation:\nRange(\"A1\").Copy\n'Paste Formats\nRange(\"B1\").PasteSpecial Paste:=xlPasteFormats\n'Paste Column Widths\nRange(\"B1\").PasteSpecial Paste:=xlPasteColumnWidths\n'Paste Formulas\nRange(\"B1\").PasteSpecial Paste:=xlPasteFormulas\n\n'Perform Multiple Paste Special Operations at Once:\nRange(\"A1\").Copy\n'Paste Formats and Transpose\nRange(\"B1\").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=True\n\nApplication.CutCopyMode = False\n\nEnd Sub"]
[null,"Copy and Value Paste","\nSub ValuePaste()\n\n'Value Paste Cells\nRange(\"B1\").value = Range(\"A1\").value\nRange(\"B1:B3\").value = Range(\"A1:A3\").value\n\n'Set Values Between Worksheets\nWorksheets(\"sheet2\").range(\"A1\").value = Worksheets(\"sheet1\").range(\"A1\").value\n\n'Set Values Between Workbooks\nWorkbooks(\"book2.xlsm\").Worksheets(\"sheet1\").range(\"A1\").value = _\nWorkbooks(\"book1.xlsm\").Worksheets(\"sheet1\").range(\"A1\").value\n\nApplication.CutCopyMode = False\n\nEnd Sub"]
[null,"Paste Formats","Sub FormatPainter()\n\nRange(\"A1\").Copy\nRange(\"B1\").PasteSpecial Paste:=xlPasteFormats\nApplication.CutCopyMode = False\n    End Sub\r\n"]
[]
["Events","Call Macro From Right-Click Menu","Private Sub Workbook_Open()\nDim MyMenu As Object\n\nSet MyMenu = Application.ShortcutMenus(xlWorksheetCell) _\n    .MenuItems.AddMenu(\"This is my Custom Menu\", 1)\n\nWith MyMenu.MenuItems\n    .Add \"MyMacro1\", \"MyMacro1\", , 1, , \"\"\n    .Add \"MyMacro2\", \"MyMacro2\", , 2, , \"\"\nEnd With\n\nSet MyMenu = Nothing\n\nEnd Sub\r\n"]
[null,"Force Workbook to Save","\nPrivate Sub Workbook_BeforeClose(Cancel As Boolean)\n\nIf Saved = False Then\n    ActiveWorkbook.Save\nEnd If\n\nEnd Sub"]
[null,"Run a Macro When Excel Starts","\nPrivate Sub auto_open()\n\nMsgBox \"This code ran at Excel start!\"\n\nEnd Sub"]
[null,"Run Macro when Cell Changes","Private Sub Worksheet_Change(ByVal Target As Range)\n\nIf Target.Address = \"$A$1\" Then\n     MsgBox \"This Code Runs When Cell A1 Changes!\"\nEnd If\n\nEnd Sub"]
[null,"Run Macro When Excel Closes","\nPrivate Sub auto_close()\nMsgBox \"This code ran at Excel close!\"\n\r\nEnd Sub\r\n"]
[null,"Set the Default Sheet When a WorkBook Opens","\nPrivate Sub Workbook_Open()\n\nSheets(\"mytabname\").Activate\n\nEnd Sub \r\n\r\n\r\n"]
[null,"Show Form When Excel Starts","\nPrivate Sub Workbook_Open()\r\nUserForm1.Show\r\n\r\nEnd Sub\r\n"]
[]
["Formatting","Autofill","\nPublic Sub MyAutoFill()\n\n'Declare range Variables\nDim selection1 As Range\nDim selection2 As Range\n\n'Set range variables = their respective ranges\nSet selection1 = Sheet1.Range(\"A1:A2\")\nSet selection2 = Sheet1.Range(\"A1:A20\")\n\n'Autofil'\nselection1.AutoFill Destination:=selection2\n\nEnd Sub"]
[null,"Change Cell Background Color","\nRange(\"A1\").Interior.ColorIndex = 5"]
[null,"Change Cell Color","\nOption Explicit\nPrivate Sub CommandButton1_Click()\r\n\nColour_Range (Sheets(\"Sheet2\").Range(\"A1:A2000\"))\r\n\nEnd Sub\r\n\nSub Colour_Range(Cell_Range As Range)\r\n\n' Will Colour each cell in range\r\nDim Cell\r\n\nFor Each Cell In Cell_Range\r\n   Cell.Interior.ColorIndex = Cell.Row Mod 56\r\n   Cell.Offset(0, 0).Value = Cell.Row\r\nNext\r\n\nEnd Sub\r\n"]
[null,"Clear Formats From a Range of Cells","Public Sub RemoveFormatting()\n\nDim c As Range\n\nFor Each c In Range(\"A:A\")\n     c.ClearFormats\nNext c\n\nEnd Sub"]
[null,"Highlight Duplicates","\nSub Highlight_Duplicates(Values As Range)\nDim Cell\n\nFor Each Cell In Values\n    If WorksheetFunction.CountIf(Values, Cell.Value) > 1 Then\n        Cell.Interior.ColorIndex = 6\n    End If\nNext Cell\n\nEnd Sub"]
[]
["Forms, Inputs, and Message Boxes","Input Box","\nPublic Sub MyInputBox()\n\nDim MyInput As String\nMyInput = InputBox(\"This is my InputBox\", \"MyInputTitle\", \"Enter your input text HERE\")\n\nIf MyInput = \"Enter your input text HERE\" Or  MyInput = \"\" Then\n    Exit Sub\nElse\n    MsgBox \"The text from MyInputBox is \" & MyInput\nEnd If\n\nEnd Sub\r\n"]
[null,"Message Box Line Break","MsgBox \"line 1\" & vbCrLf & \"line 2\""]
[null,"Show Form When Excel Starts","\nPrivate Sub Workbook_Open()\r\nUserForm1.Show\r\n\r\nEnd Sub\r\n"]
[null,"Yes No Message Box","\nSub YesNoMessageBox()\r\nDim Answer As String\r\nDim MyNote As String\r\n\r\n'Place your text here\r\nMyNote = \"Do you agree?\"\r\n\r\n'Display MessageBox\r\nAnswer = MsgBox(MyNote, vbQuestion + vbYesNo, \"???\")\r\n\r\nIf Answer = vbNo Then\r\n      'Code for No button Press\r\n      MsgBox \"You pressed NO!\"\r\nElse\r\n      'Code for Yes button Press\r\n      MsgBox \"You pressed Yes!\"\r\nEnd If\r\n\r\nEnd Sub\r\n"]
[]
["Formulas and Functions","Add Spaces to a Sring","\nSub AddSpaces()\nDim MyString As String\n\nMyString = \"Hello\" & Space(10) & \"World\"\n\nMsgBox MyString\n\nEnd Sub\r\n"]
[null,"Automatic Calculations - Turn Off (Manual)","\nApplication.Calculation = xlManual"]
[null,"Automatic Calculations - Turn On","\nApplication.Calculation = xlAutomatic"]
[null,"Check if Date is Inbetween Dates","\nFunction Compare_Dates(Start_Date As Date, End_Date As Date, Other_Date As Date) As Boolean\n\n' Boolean Function to compare dates\n'Will return TRUE only when Other_Date is between Start_Date and End_Date\n'Otherwise will return FALSE\n'Set outcome to FALSE - default value\n\nCompare_Dates = False\n\n'Compare Dates\nIf ((Other_Date >= Start_Date) And (Other_Date <= End_Date)) Then\n  'If Other Date is between Start and End Date then set to true  Compare_Dates = True\r\nEnd If\n\nEnd Function\r\n"]
[null,"Count Number of Words","\nFunction Number_of_Words(Text_String As String) As Integer\n\n'Function counts the number of words in a string\n'by looking at each character and seeing whether it is a space or not\nNumber_of_Words = 0\nDim String_Length As Integer\nDim Current_Character As Integer\nString_Length = Len(Text_String)\n\r\nFor Current_Character = 1 To String_Length\n\r\n  If (Mid(Text_String, Current_Character, 1)) = \" \" Then\n      Number_of_Words = Number_of_Words + 1\n  End If\n\r\nNext Current_Character\n\nEnd Function\r\n"]
[null,"Create Acronym From Text String","\nFunction Acroymn (Original_String As String) As String\nDim Trimmed_String As String\r\nDim Length As Integer\r\nDim Pos As Integer\r\n\nTrimmed_String = Application.WorksheetFunction.Trim(Original_String)\r\n\r\n'work out the length of the string\r\nLength = Len(Trimmed_String)\r\n\r\nAcroymn = UCase(Left(Trimmed_String, 1))\r\n\nFor Pos = 2 To Length - 1\r\n    If (Mid(Trimmed_String, Pos, 1) = \" \") Then\r\n    Acroymn = Acroymn & UCase(Mid(Trimmed_String, Pos + 1, 1))\r\n    End If\r\nNext Pos\r\n\nEnd Function\r\n"]
[null,"Extract Numbers from String","\nFunction Extract_Number_from_Text(Phrase As String) As Double\n\nDim Length_of_String As Integer\nDim Current_Pos As Integer\nDim Temp As String\n\nLength_of_String = Len(Phrase)\nTemp = \"\"\n\nFor Current_Pos = 1 To Length_of_String\n\n  If (Mid(Phrase, Current_Pos, 1) = \"-\") Then\n    Temp = Temp & Mid(Phrase, Current_Pos, 1)\n  End If\n\n  If (Mid(Phrase, Current_Pos, 1) = \".\") Then\n    Temp = Temp & Mid(Phrase, Current_Pos, 1)\n  End If\n\n  If (IsNumeric(Mid(Phrase, Current_Pos, 1))) = True Then\n    Temp = Temp & Mid(Phrase, Current_Pos, 1)\n  End If\n\nNext Current_Pos\n\nIf Len(Temp) = 0 Then\n    Extract_Number_from_Text = 0\nElse\n    Extract_Number_from_Text = CDbl(Temp)\nEnd If\n\nEnd Function"]
[null,"Find Text in String","\nPublic Sub FindSomeText()\n\nIf InStr(\"Look in this string\", \"look\") = 0 Then\n   MsgBox \"woops, no match\"\nElse\n   MsgBox \"at least one match\"\nEnd If\n\nEnd Sub"]
[null,"Find the Max Value in Each Column","\nFunction Max_Each_Column(Data_Range As Range) As Variant\nDim TempArray() As Double, i As Long\r\n\nIf Data_Range Is Nothing Then Exit Function\n\nWith Data_Range\n  ReDim TempArray(1 To .Columns.Count)\n\n  For i = 1 To .Columns.Count\n    TempArray(i) = Application.Max(.Columns(i))\n  Next\nEnd With\n\nMax_Each_Column = TempArray\n\nEnd Function\r\n"]
[null,"Force Proper Case","\nPrivate Sub Worksheet_Change(ByVal Target As Excel.Range)\n\nApplication.EnableEvents = False\n\nIf Target.Column = 5 Then\n  Target = StrConv(Target, vbProperCase)\nEnd If\n\nApplication.EnableEvents = True\nEnd Sub"]
[null,"Return nth Word","\nFunction Find_nth_word(Phrase As String, n As Integer) As String\n\nDim Current_Pos As Long\nDim Length_of_String As Integer\nDim Current_Word_No As Integer\n\nFind_nth_word = \"\"\nCurrent_Word_No = 1\n\n'Remove Leading Spaces\nPhrase = Trim(Phrase)\n\nLength_of_String = Len(Phrase)\n\nFor Current_Pos = 1 To Length_of_String\n    If (Current_Word_No = n) Then\n        Find_nth_word = Find_nth_word & Mid(Phrase, Current_Pos, 1)\n    End If\n    If (Mid(Phrase, Current_Pos, 1) = \" \") Then\n     Current_Word_No = Current_Word_No + 1\n    End If\nNext Current_Pos\n\n'Remove the rightmost space\nFind_nth_word = Trim(Find_nth_word)\n\nEnd Function\r\n"]
[null,"Reverse a Text String","\nOption Explicit\r\nPrivate Sub CommandButton1_Click()\r\n\r\n'Define Variables\r\n\r\nDim Original_String As String\r\nDim Reversed_String As String\r\nDim Next_Char As String\r\n\r\nDim Length As Integer\r\nDim Pos As Integer\r\n\r\n'Get the Original String\r\n\r\nOriginal_String = InputBox(\"Pls enter the original string: \")\r\n\r\n'Find the revised length of the string\r\n\r\nLength = Len(Original_String)\r\n\r\n'Set up the reversed string\r\nReversed_String = \"\"\r\n\r\n'Progress through the string on a character by character basis\r\n'Starting at the last character and going towards the first character\r\n\r\nFor Pos = Length To 1 Step -1\r\n\r\n    Next_Char = Mid(Original_String, Pos, 1)\r\n    Reversed_String = Reversed_String & Next_Char\r\nNext Pos\r\n\r\nMsgBox \"The reversed string is \" & Reversed_String\r\n\r\nEnd Sub\r\n"]
[null,"Show Cell Formula","\nFunction Show_Cell_Formulae(Cell As Range) As String\n  Show_Cell_Formulae = \"Cell \" & Cell.Address & \" has the formulae: \" & Cell.Formula & \" '\"\r\nEnd Function\r\n"]
[null,"Sumif By Color","Function Color_By_Numbers(Color_Range As Range, Color_Index As Integer) As Double\n\n' Dim Color_By_Numbers  As Double\nDim Cell\n'Will look at cells that are in the range and if\n'the color interior property matches the cell color required\n'then it will sum\n\r\n'Loop Through range\nFor Each Cell In Color_Range\n\n  If (Cell.Interior.ColorIndex = Color_Index) Then\n    Color_By_Numbers = Color_By_Numbers + Cell.Value\n  End If\n\r\nNext Cell\n\r\nEnd Function\r\n"]
[null,"Trim Characters From Left","\nmsgbox Right(Mystring, 9)"]
[null,"Trim Characters From Right","\nMsgBox Right(Mystring, Len(Mystring) - 1)"]
[null,"Use WorksheetFunction","Sub UseFunction()\n\nMsgBox Application.WorksheetFunction.Combin(42, 6)\n\nEnd Sub"]
[null,"Vlookup With Multiple Conditions","\nFunction ThreeParameterVlookup(Data_Range As Range, Col As Integer, Parameter1 As Variant, Parameter2 As Variant, Parameter3 As Variant) As Variant\n\n'Declare VariablesDim Cell\r\nDim Current_Row As Integer\r\nDim No_Of_Rows_in_Range As Integer\r\nDim No_of_Cols_in_Range As Integer\r\nDim Matching_Row As Integer\r\n\r\n'set answer to N/A by default\r\nThreeParameterVlookup = CVErr(xlErrNA)\r\nMatching_Row = 0\r\nCurrent_Row = 1\r\n\r\nNo_Of_Rows_in_Range = Data_Range.Rows.Count\r\nNo_of_Cols_in_Range = Data_Range.Columns.Count\r\n\r\n'Check if Col is greater than number of columns in range\r\n\r\nIf (Col > No_of_Cols_in_Range) Then\r\n  ThreeParameterVlookup = CVErr(xlErrRef)\r\nEnd If\r\nIf (Col <= No_of_Cols_in_Range) Then\r\n  Do\r\nIf ((Data_Range.Cells(Current_Row, 1).Value = Parameter1) And _\n(Data_Range.Cells(Current_Row, 2).Value = Parameter2) And _\n(Data_Range.Cells(Current_Row, 3).Value = Parameter3)) Then\r\nMatching_Row = Current_Row\r\n\r\nEnd If\r\nCurrent_Row = Current_Row + 1\r\nLoop Until ((Current_Row = No_Of_Rows_in_Range) Or (Matching_Row <> 0))\r\n\r\nIf Matching_Row <> 0 Then\r\n  ThreeParameterVlookup = Data_Range.Cells(Matching_Row, Col)\r\nEnd If\r\n\r\nEnd If\r\n\r\nEnd Function\r\n"]
[]
["Interaction and View","Autofilter - Turn Off","\nPublic Sub KillFilter()\r\nIf ActiveSheet.AutoFilterMode Then\r\n  ActiveSheet.AutoFilterMode = False\r\nEnd If\r\n\r\nEnd Sub\r\n"]
[null,"Autofilter - Turn On","\nPublic Sub StartFilter()\r\nIf Not ActiveSheet.AutoFilterMode Then\r\n     ActiveSheet.Range(\"A1\").AutoFilter\r\nEnd If\r\n\nEnd Sub\r\n"]
[null,"Automatic Calculations - Turn Off (Manual)","\nApplication.Calculation = xlManual"]
[null,"Automatic Calculations - Turn On","\nApplication.Calculation = xlAutomatic"]
[null,"Change ActiveWindow State","ActiveWindow.WindowState = xlMinimized\nActiveWindow.WindowState = xlMaximized\nActiveWindow.WindowState = xlNormal"]
[null,"Change User Name","\nApplication.UserName = \"MonkeyCoder\""]
[null,"Display Alerts - Turn Off","\nApplication.DisplayAlerts = False"]
[null,"Display Alerts - Turn On","\nApplication.DisplayAlerts = True"]
[null,"Formula Bar - Turn Off","\nSub OffFormulaBar()\n    Application.DisplayFormulaBar = False\nEnd Sub"]
[null,"Formula Bar - Turn On","\nSub OnFormulaBar()\n    Application.DisplayFormulaBar = True\nEnd Sub"]
[null,"Freeze Panes - Turn Off","\nActiveWindow.FreezePanes = False"]
[null,"Freeze Panes - Turn On","Rows(\"1:1\").Select\nActiveWindow.FreezePanes = True"]
[null,"Full Screen Mode - Turn Off (Exit)","Application.DisplayFullScreen = False"]
[null,"Full Screen Mode - Turn On","\nApplication.DisplayFullScreen = True"]
[null,"Hide Macro - Private Sub","\nSub Macro1()\n\n  Call Macro2\n\nEnd Sub\r\nPrivate Sub Macro2()\n\n  MsgBox \"You can only see Macro1\"\n\nEnd Sub\r\n"]
[null,"Hide Worksheet Tabs","\nSub Hide_Tabs\n\n'Hide sheet tabs\nActiveWindow.DisplayWorkbookTabs = False\n\nEnd Sub "]
[null,"Page Break Preview Mode - Turn Off","\nSheet1.Activate\r\nActiveWindow.View = xlNormalView\r\n"]
[null,"Page Break Preview Mode - Turn On","\nSheet1.Activate\nActiveWindow.View = xlPageBreakPreview"]
[null,"ScreenUpdating - Turn Off","\nApplication.ScreenUpdating = False"]
[null,"ScreenUpdating - Turn On","\nApplication.ScreenUpdating = True"]
[null,"Scroll Bars - Turn Off","\nSub TurnOffScroll()\n\nWith ActiveWindow\n  .DisplayHorizontalScrollBar = False\n  .DisplayVerticalScrollBar = False\nEnd With\n\nEnd Sub"]
[null,"Scroll Bars - Turn On","\nSub TurnOnScroll()\nWith ActiveWindow\n  .DisplayHorizontalScrollBar = True\n  .DisplayVerticalScrollBar = True\nEnd With\n\nEnd Sub\r\n"]
[null,"Scroll Column","\nActiveWindow.ScrollColumn = 5"]
[null,"Scroll Row","\nActiveWindow.ScrollRow = 5"]
[null,"Set Zoom Percentage for all Worksheets","\nSub ZoomAll()\n\nDim ws As Worksheet\n\nFor Each ws In Worksheets\n    ws.Activate\n    ActiveWindow.Zoom = 50\nNext\n\nEnd Sub"]
[null,"StatusBar - Custom Message","\nApplication.StatusBar = \"I'm working Now!!!\""]
[null,"StatusBar - Turn Off","\nApplication.StatusBar = FALSE"]
[null,"StatusBar - Turn On","\nApplication.DisplayStatusBar = True"]
[null,"Titlebar - Modify","\nPrivate Sub auto_open()\n'This Macro will run every time the workbook opens.\n\nApplication.Caption = (\"AutomateExcel.com\")\n\nEnd Sub"]
[null,"Zoom - Fit Selection","\nSheet1.Range(\"A1:F15\").Select\n'set range zoom\nActiveWindow.Zoom = True"]
[]
["Loops and Fors","Clear Formats From a Range of Cells","Public Sub RemoveFormatting()\n\nDim c As Range\n\nFor Each c In Range(\"A:A\")\n     c.ClearFormats\nNext c\n\nEnd Sub"]
[null,"Create Hyperlink Menu of Worksheets","Sub ListSheets()\nDim ws As Worksheet\nDim x As Integer\n\nx = 1\n\nSheets(\"Sheet1\").Range(\"A:A\").Clear\r\n\r\nFor Each ws In Worksheets\n   Sheets(\"Sheet1\").Cells(x, 1).Select\n   ActiveSheet.Hyperlinks.Add _\n   Anchor:=Selection, Address:=\"\", SubAddress:= _\n   ws.Name & \"!A1\", TextToDisplay:=ws.Name\n  x = x + 1\nNext ws\n\nEnd Sub\r\n"]
[null,"Create Worksheets From List of Names","\nFunction Sheet_Exists(WorkSheet_Name As String) As Boolean\n\nDim Work_sheet As Worksheet\nSheet_Exists = False\nFor Each Work_sheet In ThisWorkbook.Worksheets\n    If Work_sheet.Name = WorkSheet_Name Then\n        Sheet_Exists = True\n    End If\nNext\n\nEnd Function\r\n"]
[null,"Delete all Autoshapes from Workbook","\nSub DeleteAllShapes()\n'Activate sheet to delete autoshapes\nSheet1.Activate\n\nDim GetShape As Shape\n\nFor Each GetShape In ActiveSheet.Shapes\n  GetShape.Delete\nNext\n\nEnd Sub\r\n"]
[null,"Delete all Named Ranges","Sub DeleteNamedRanges()\nDim MyName As Name\r\n\r\nFor Each MyName In Names\r\n    ActiveWorkbook.Names(MyName.Name).Delete\nNext\n\nEnd Sub\r\n"]
[null,"Highlight Duplicates","\nSub Highlight_Duplicates(Values As Range)\nDim Cell\n\nFor Each Cell In Values\n    If WorksheetFunction.CountIf(Values, Cell.Value) > 1 Then\n        Cell.Interior.ColorIndex = 6\n    End If\nNext Cell\n\nEnd Sub"]
[null,"List All worksheets in Workbook","\nSub ListSheets()\r\nDim ws As Worksheet\r\nDim x As Integer\r\n\r\nx = 1\r\n\r\nSheets(\"Sheet1\").Range(\"A:A\").Clear\r\n\r\nFor Each ws In Worksheets\r\n     Sheets(\"Sheet1\").Cells(x, 1) = ws.Name\r\n     x = x + 1\r\nNext ws\r\n\r\nEnd Sub\r\n"]
[null,"Loop Through an Entire Column","\nPublic Sub LoopColumn()\nDim c As Range\r\n\nFor Each c In Range(\"A:A\")\r\n\r\n    If c.Value = \"FindMe\" Then\r\n       MsgBox \"FindMe found at \" & c.Address\r\n    End If\r\n\r\nNext\n\nEnd Sub\r\n"]
[null,"Loop Through an Entire Row","\nPublic Sub LoopRow()\n\nDim c As Range\n\nFor Each c In Range(\"1:1\")\n\n    If c.Value = \"FindMe\" Then\n      MsgBox \"FindMe found at \" & c.Address\n    End If\n\nNext c\n\nEnd Sub "]
[null,"Loop Through Each Character in Text String","\nSub LoopThroughString()\n\nDim Counter As Integer\nDim MyString As String\nMyString = \"AutomateExcel\" 'define string\n\r\nFor Counter = 1 To Len(MyString)\n    'do something to each character in string\n    'here we'll msgbox each character\n    MsgBox Mid(MyString, Counter, 1)\nNext\n\nEnd Sub\r\n"]
[null,"Loop Through Each Sheet in Workbook","\nFor Each ws In Worksheets\n  'Update or do something here\nNext"]
[null,"Set Zoom Percentage for all Worksheets","\nSub ZoomAll()\n\nDim ws As Worksheet\n\nFor Each ws In Worksheets\n    ws.Activate\n    ActiveWindow.Zoom = 50\nNext\n\nEnd Sub"]
[null,"Sort Sheets Alphabetically","\nSub Sort_Sheets()\n\nDim Sort_Mode_Descending As Boolean\nDim No_of_Sheets As Integer\nDim Outer_Loop As Integer\nDim Inner_Loop As Integer\n\nNo_of_Sheets = Sheets.Count\n\n'Change Flag As appropriate\nSort_Mode_Descending = False\n\nFor Outer_Loop = 1 To No_of_Sheets\n  For Inner_Loop = 1 To Outer_Loop\n    If Sort_Mode_Descending = True Then\n      If UCase(Sheets(Outer_Loop).Name) > UCase(Sheets(Inner_Loop).Name) Then\n        Sheets(Outer_Loop).Move Before:=Sheets(Inner_Loop)\n      End If\n    End If\n    If Sort_Mode_Descending = False Then\n      If UCase(Sheets(Outer_Loop).Name) < UCase(Sheets(Inner_Loop).Name) Then\n        Sheets(Outer_Loop).Move Before:=Sheets(Inner_Loop)\n      End If\n        End If\n\n  Next Inner_Loop\nNext Outer_Loop\n\nEnd Sub\r\n"]
[null,"Sumif By Color","\nFunction Color_By_Numbers(Color_Range As Range, Color_Index As Integer) As Double\n\n' Dim Color_By_Numbers  As Double\nDim Cell\n\r\n'Will look at cells that are in the range and if\n'the color interior property matches the cell color required\n'then it will sum\n\r\n'Loop Through range\nFor Each Cell In Color_Range\n\n  If (Cell.Interior.ColorIndex = Color_Index) Then\n    Color_By_Numbers = Color_By_Numbers + Cell.Value\n  End If\n\r\nNext Cell\n\r\nEnd Function\r\n"]
[null,"Test if Workbook is Open","\nSub TestByWorkbookName()\nDim wb As Workbook\n\nFor Each wb In Workbooks\n'replace between the quotes with workbook to test for\n\n  If wb.Name = \"New Microsoft Excel Worksheet.xls\" Then\n        MsgBox \"Found it\"\n        Exit Sub 'call code here, we'll just exit for now\n  End If\n\nNext\r\n\nEnd Sub\r\n"]
[null,"Unhide All Worksheets","\nSub UnhideAll()\nDim WS As Worksheet\n\nFor Each WS In Worksheets\n     WS.Visible = True\nNext\n\nEnd Sub"]
[]
["Misc","Automate Internet Explorer","\nSub Automate_IE_Load_Page()\n'This will load a webpage in IE\r\n    Dim i As Long\r\n    Dim URL As String\r\n    Dim IE As Object\r\n    Dim objElement As Object\r\n    Dim objCollection As Object\r\n \r\n    'Create InternetExplorer Object\r\n    Set IE = CreateObject(\"InternetExplorer.Application\")\r\n \r\n    'Set IE.Visible = True to make IE visible, or False for IE to run in the background\r\n    IE.Visible = True\r\n \r\n    'Define URL\r\n    URL = \"http://www.automateexcel.com/\"\r\n \r\n    'Navigate to URL\r\n    IE.Navigate URL\r\n \r\n    ' Statusbar let's user know website is loading\r\n    Application.StatusBar = URL & \" is loading. Please wait...\"\r\n \r\n    ' Wait while IE loading...\r\n    'IE ReadyState = 4 signifies the webpage has loaded (the first loop is set to avoid inadvertently skipping over the second loop)\r\n    Do While IE.ReadyState = 4: DoEvents: Loop   'Do While\r\n    Do Until IE.ReadyState = 4: DoEvents: Loop   'Do Until\r\n \r\n    'Webpage Loaded\r\n    Application.StatusBar = URL & \" Loaded\"\r\n    \r\n    'Unload IE\r\n    Set IE = Nothing\r\n    Set objElement = Nothing\r\n    Set objCollection = Nothing\r\n    \r\nEnd Sub\r\n"]
[null,"Cell Comment - Delete","Sheet1.Range(\"A1\").Comment.Delete"]
[null,"Cell Comment - Insert","\nSheet1.Range(\"A1\").AddComment (\"Hello World\")"]
[null,"Convert Matrix to Vector","\nOption Explicit\n\nFunction Create_Vector(Matrix_Range As Range) As Variant\n\nDim No_of_Cols As Integer, No_Of_Rows As Integer\nDim i As Integer\nDim j As Integer\nDim Cell\n\nNo_of_Cols = Matrix_Range.Columns.Count\nNo_Of_Rows = Matrix_Range.Rows.Count\nReDim Temp_Array(No_of_Cols * No_Of_Rows)\n\n'Eliminate NULL Conditions\nIf Matrix_Range Is Nothing Then Exit Function\nIf No_of_Cols = 0 Then Exit Function\nIf No_Of_Rows = 0 Then Exit Function\n\nFor j = 1 To No_Of_Rows\n  For i = 0 To No_of_Cols - 1\n    Temp_Array((i * No_Of_Rows) + j) = Matrix_Range.Cells(j, i + 1)\n  Next i\nNext j\n\nCreate_Vector = Temp_Array\n\nEnd Function"]
[null,"Convert Single Row Vector into Matrix","\nFunction Create_Matrix(Vector_Range As Range, No_Of_Cols_in_output As Integer, No_of_Rows_in_output As Integer) As Variant\n\nReDim Temp_Array(No_Of_Cols_in_output, No_of_Rows_in_output)\nDim No_Of_Elements_In_Vector As Integer\nDim Col_Count As Integer, Row_Count As Integer\nDim Cell\n\nNo_Of_Elements_In_Vector = Vector_Range.Rows.Count\n\n'Eliminate NULL Conditions\nIf Vector_Range Is Nothing Then Exit Function\nIf No_Of_Cols_in_output = 0 Then Exit Function\nIf No_of_Rows_in_output = 0 Then Exit Function\nIf No_Of_Elements_In_Vector = 0 Then Exit Function\n\nFor Col_Count = 1 To No_Of_Cols_in_output\n    For Row_Count = 1 To No_of_Rows_in_output\n    Temp_Array(Col_Count, Row_Count) = Vector_Range.Cells(((No_of_Rows_in_output) * (Col_Count - 1) + Row_Count), 1)\n        Next Row_Count\nNext Col_Count\n\nCreate_Matrix = Temp_Array\n\nEnd Function"]
[null,"Create Bar Chart","\nSub MakeChart()\nDim myRange As Range\n  Set myRange = Application.InputBox (Prompt:=\"Select chart inputs\", Type:=8)\n  Charts.Add\n  ActiveChart.ChartType = xlColumnClustered\n  ActiveChart.SetSourceData Source:=myRange, _\n  PlotBy:=xlColumns\n  ActiveChart.Location Where:=xlLocationAsNewSheet\n\nEnd Sub\r\n"]
[null,"Create Data Validation List","Sub ProgramValidate()\n\n    Dim Choices As String\n    Choices = \"1. Choice1, 2. Choice2, 3. Choice3\"\n\n    Range(\"A1\").Select\n\n    With Selection.Validation\n        .Delete\n        .Add Type:=xlValidateList, _\n        AlertStyle:=xlValidAlertStop, Operator:= _\n        xlBetween, Formula1:=Choices\n        .IgnoreBlank = True\n        .InCellDropdown = True\n        .InputTitle = \"\"\n        .ErrorTitle = \"\"\n        .InputMessage = \"\"\n        .ErrorMessage = \"\"\n        .ShowInput = True\n        .ShowError = True\n    End With\n\nEnd Sub"]
[null,"Create Hyperlink Menu of Worksheets","Sub ListSheets()\nDim ws As Worksheet\nDim x As Integer\n\nx = 1\n\nSheets(\"Sheet1\").Range(\"A:A\").Clear\n\r\nFor Each ws In Worksheets\n   Sheets(\"Sheet1\").Cells(x, 1).Select\n   ActiveSheet.Hyperlinks.Add _\n   Anchor:=Selection, Address:=\"\", SubAddress:= _\n   ws.Name & \"!A1\", TextToDisplay:=ws.Name\n  x = x + 1\nNext ws\n\nEnd Sub\r\n"]
[null,"Delete all Autoshapes from Workbook","\nSub DeleteAllShapes()\n'Activate sheet to delete autoshapes\nSheet1.Activate\n\nDim GetShape As Shape\n\nFor Each GetShape In ActiveSheet.Shapes\n  GetShape.Delete\nNext\n\nEnd Sub\r\n"]
[null,"Delete All Hyperlinks","Sub DeleteHyperLinks()\n\nSheet1.Hyperlinks.Delete\n\nEnd Sub"]
[null,"Draw AutoShape Boxes","Sub DynamicBoxes()\n\nDim x As Double\n\n'This makes horizontal boxes\nFor x = 0 To 240 Step 48\n\n  'reference to the 4 numbers left,top,width,height\n  ActiveSheet.Shapes.AddShape (msoShapeFlowchartProcess, x, 0, 48, 12.75).Select\n  Selection.ShapeRange.Fill.ForeColor.SchemeColor = 11\n  Selection.ShapeRange.Fill.Solid\n  Selection.ShapeRange.Fill.Visible = msoTrue\nNext x\n\n'This makes vertical boxes\nFor x = 0 To 127.5 Step 12.75\n\nActiveSheet.Shapes.AddShape(msoShapeFlowchartProcess, 0, x, 48, 12.75).Select\n  Selection.ShapeRange.Fill.ForeColor.SchemeColor = 11\n  Selection.ShapeRange.Fill.Solid\n  Selection.ShapeRange.Fill.Visible = msoTrue\nNext x\n\nEnd Sub"]
[null,"Exit Without Saving","\nSub ExitWithoutPrompt()\n\nApplication.DisplayAlerts = False\nApplication.Quit\n\nEnd Sub"]
[null,"Export Range to CSV","\nFunction ExportRange(WhatRange As Range,Where As String, Delimiter As String) As String\n\nDim HoldRow As Long    'test for new row variable\nHoldRow = WhatRange.Row\nDim c As Range    'loop through range variable\n\nFor Each c In WhatRange\n    If HoldRow <> c.Row Then\n        'add linebreak and remove extra delimeter\n        ExportRange = Left(ExportRange, Len(ExportRange) - 1) & vbCrLf & c.Text & Delimiter\n        HoldRow = c.Row\n    Else\n        ExportRange = ExportRange & c.Text & Delimiter\n    End If\nNext c\n\n'Trim extra delimiter\nExportRange = Left(ExportRange, Len(ExportRange) - 1)\n\n'Kill the file if it already exists\nIf Len(Dir(Where)) > 0 Then\n    Kill Where\nEnd If\n\nOpen Where For Append As #1    'write the new file\nPrint #1, ExportRange\nClose #1\n\nEnd Function"]
[null,"Hide Excel Application","\nPublic Sub HideMyExcel()\n\nApplication.Visible = False\nApplication.Wait Now + TimeValue(\"00:00:05\")\nApplication.Visible = True\n\nEnd Sub"]
[null,"Hide Macro - Private Sub","\nSub Macro1()\n\n  Call Macro2\n\nEnd Sub\r\nPrivate Sub Macro2()\n\n  MsgBox \"You can only see Macro1\"\n\nEnd Sub\r\n"]
[null,"Populate Cells with Random Values","\nSub Randomise_Range(Cell_Range As Range)\n\nApplication.ScreenUpdating = False\n\n' Will randomise each cell in Range\nDim Cell\n\nFor Each Cell In Cell_Range\n  Cell.Value = Rnd * 1000\nNext Cell\n\nApplication.ScreenUpdating = True\nEnd Sub"]
[null,"Resize Object to Fit Range","\nSub SizeChart2Range()\n\nDim MyChart As Chart\nDim MyRange As Range\n\nSet MyChart = ActiveSheet.ChartObjects(1).Chart\nSet MyRange = Sheet1.Range(\"B2:D6\")\n\n    With MyChart.Parent\n        .Left = MyRange.Left\n        .Top = MyRange.Top\n        .Width = MyRange.Width\n        .Height = MyRange.Height\n    End With\n\nEnd Sub"]
[null,"Save Worksheet as New Workbook and Email","\nSub Mail_Workbook()\n\nApplication.DisplayAlerts = False\nApplication.enableevents = False\nApplication.ScreenUpdating = False\nApplication.Calculation = xlCalculationManual\nDim OutApp As Object\nDim OutMail As Object\nDim FilePath As String\nDim Project_Name As String\nDim Template_Name As String\nDim ReviewDate As String\nDim SaveLocation As String\nDim Path As String\nDim Name As String\n\r\n'Create Initial variables\nSet OutApp = CreateObject(\"Outlook.Application\")\nSet OutMail = OutApp.CreateItem(0)\nProject_Name = Sheets(\"sheet1\").Range(\"ProjectName\").Value\nTemplate_Name = ActiveSheet.Name\n\r\n'Ask for Input used in Email\nReviewDate = InputBox(Prompt:=\"Provide date by when you'd like the submission reviewed.\", Title:=\"Enter Date\", Default:=\"MM/DD/YYYY\")\n\nIf ReviewDate = \"Enter Date\" Or ReviewDate = vbNullString Then GoTo endmacro\n\r\n'Save Worksheet as own workbook\nPath = ActiveWorkbook.Path\n    Name = Trim(Mid(ActiveSheet.Name, 4, 99))\n\r\n\r\nSet ws = ActiveSheet\nSet oldWB = ThisWorkbook\n\r\nSaveLocation = InputBox(Prompt:=\"Choose File Name and Location\", Title:=\"Save As\", Default:=CreateObject(\"WScript.Shell\").SpecialFolders(\"Desktop\") & \"/\" & Name & \".xlsx\")\n\r\n    If Dir(SaveLocation) <> \"\" Then\n    MsgBox (\"A file with that name already exists. Please choose a new name or delete existing file.\")\n    SaveLocation = InputBox(Prompt:=\"Choose File Name and Location\", Title:=\"Save As\", Default:=CreateObject(\"WScript.Shell\").SpecialFolders(\"Desktop\") & \"/\" & Name & \".xlsx\")\n    End If\n    \r\nIf SaveLocation = vbNullString Then GoTo endmacro\n\n'unprotect sheet if needed\nActiveSheet.Unprotect Password:=\"password\"\n\nSet newWB = Workbooks.Add\n\r\n'Adjust Display\nActiveWindow.Zoom = 80\nActiveWindow.DisplayGridlines = False\n\n'Copy + Paste Values\noldWB.Activate\noldWB.ActiveSheet.Cells.Select\nSelection.Copy\nnewWB.Activate\nnewWB.ActiveSheet.Cells.Select\n\r\n    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _\n        :=False, Transpose:=False\n    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _\n        SkipBlanks:=False, Transpose:=False\n    Selection.PasteSpecial Paste:=xlPasteValidation, Operation:=xlNone, _\n        SkipBlanks:=False, Transpose:=False\n\n'Select new WB and turn off cutcopy mode\n    newWB.ActiveSheet.Range(\"A10\").Select\n    Application.CutCopyMode = False\n\n'Save File\n    newWB.SaveAs Filename:=SaveLocation, _\n        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False\n\nFilePath = Application.ActiveWorkbook.FullName\n    \r\n'Reprotect oldWB\noldWB.ActiveSheet.Protect Password:=\"password\", DrawingObjects:=True, Contents:=True, Scenarios:=True, _\n       AllowFormattingCells:=True, AllowFormattingColumns:=True, _\n       AllowFormattingRows:=True\n\n'Email\nOn Error Resume Next\nWith OutMail\n.to = \"email@email.com\"\n.CC = \"\"\n.BCC = \"\"\n.Subject = Project_Name & \": \" & Template_Name & \" for review\"\n.Body = \"Project Name: \" & Project_Name & \", \" & Name & \" For review by \" & ReviewDate\n.Attachments.Add (FilePath)\n.Display\n' .Send      'Optional to automate sending of email.\nEnd With\nOn Error GoTo 0\nSet OutMail = Nothing\nSet OutApp = Nothing\n\n'End Macro, Restore Screenupdating, Calcs, etc...\nendmacro:\nApplication.DisplayAlerts = True\nApplication.enableevents = True\nApplication.ScreenUpdating = True\nApplication.Calculation = xlCalculationAutomatic\n\nEnd Sub\r\n"]
[null,"Search Google","Sub LaunchSite()\n\nDim newsite As Object\n\nSet newsite = CreateObject(\"InternetExplorer.application\")\n  newsite.Visible = True\n  newsite.Navigate \"http://www.google.com/search?hl=en&ie=UTF-8&q=\" & ActiveCell.Text\n\nEnd Sub"]
[null,"Show Cell Formula","\nFunction Show_Cell_Formulae(Cell As Range) As String\n  Show_Cell_Formulae = \"Cell \" & Cell.Address & \" has the formulae: \" & Cell.Formula & \" '\"\r\nEnd Function\r\n"]
[null,"Speak a Cell","Sub SayThisCell()\nCells(1, 1).Speak\r\n\nEnd Sub\r\n"]
[null,"Speak a String of Text","\nSub SayThisString()\n\nDim SayThis As String\n\nSayThis = \"I love Microsoft Excel\"\nApplication.Speech.Speak (SayThis)\n\nEnd Sub"]
[null,"Spellcheck","\nPrivate Sub Workbook_BeforeClose(Cancel As Boolean)\n\nSheet1.Cells.CheckSpelling\n\nEnd Sub"]
[null,"Test Variable Type","\nSub WhatIsTheType()\n\nDim Mark As Variant\n\nMark = 1\nMsgBox Mark & \" makes the variable \" & TypeName(Mark)\n\nMark = 111111\nMsgBox Mark & \" makes the variable \" & TypeName(Mark)\n\nMark = 111111.11\nMsgBox Mark & \" makes the variable \" & TypeName(Mark)\n\nEnd Sub"]
[null,"Timer","\nSub BenchMark()\r\nDim Count As Long\nDim BenchMark As Double\r\nBenchMark = Timer\n\n'Start of Code to Test\nFor Count = 1 To 500000\n      Sheet1.Cells(1, 1) = \"test\"\nNext Count\n\r\n'End of Code to Test\nMsgBox Timer - BenchMark\n\nEnd Sub\r\n"]
[null,"Wait, Delay or Pause","\nSub MyTimer()\nApplication.Wait Now + TimeValue(\"00:00:05\")\r\nMsgBox (\"5 seconds\")\r\n\nEnd Sub\r\n"]
[]
["Ranges","Clear Formats From a Range of Cells","Public Sub RemoveFormatting()\n\nDim c As Range\n\nFor Each c In Range(\"A:A\")\n     c.ClearFormats\nNext c\n\nEnd Sub"]
[null,"Delete all Named Ranges","Sub DeleteNamedRanges()\nDim MyName As Name\r\n\r\nFor Each MyName In Names\r\n    ActiveWorkbook.Names(MyName.Name).Delete\nNext\n\nEnd Sub\r\n"]
[null,"Join Multiple Ranges","\nSub UnionExample()\n\nDim Rng1, Rng2, Rng3 As Range\n\nSet Rng1 = Range(\"A1,A3,A5,A7,A9,A11,A13,A15,A17,A19,A21\")\nSet Rng2 = Range(\"C1,C3,C5,C7,C9,C11,C13,C15,C17,C19,C21\")\nSet Rng3 = Range(\"E1,E3,E5,E7,E9,E11,E13,E15,E17,E19,E21\")\n\nUnion(Rng1, Rng2, Rng3).Select\n\nEnd Sub"]
[null,"Resize Object to Fit Range","\nSub SizeChart2Range()\n\nDim MyChart As Chart\nDim MyRange As Range\n\nSet MyChart = ActiveSheet.ChartObjects(1).Chart\nSet MyRange = Sheet1.Range(\"B2:D6\")\n\n    With MyChart.Parent\n        .Left = MyRange.Left\n        .Top = MyRange.Top\n        .Width = MyRange.Width\n        .Height = MyRange.Height\n    End With\n\nEnd Sub"]
[null,"Select all Cells in Worksheet","\nSub MySelectAll()\n\n  Sheet1.Activate\n  Sheet1.Cells.Select\n\nEnd Sub"]
[null,"Test if Selection is in Range","Sub TestIfRange()\n\nIf TypeName(Selection) = \"Range\" Then\n    MsgBox \"You selected a Range\"\nElse\n    MsgBox \"Woops! You selected a \" & TypeName(Selection)\nEnd If\n\nEnd Sub"]
[]
["Text","Add Spaces to a Sring","\nSub AddSpaces()\nDim MyString As String\n\nMyString = \"Hello\" & Space(10) & \"World\"\n\nMsgBox MyString\n\nEnd Sub\r\n"]
[null,"Count Number of Words","\nFunction Number_of_Words(Text_String As String) As Integer\n\n'Function counts the number of words in a string\n'by looking at each character and seeing whether it is a space or not\nNumber_of_Words = 0\nDim String_Length As Integer\nDim Current_Character As Integer\nString_Length = Len(Text_String)\n\r\nFor Current_Character = 1 To String_Length\n\r\n  If (Mid(Text_String, Current_Character, 1)) = \" \" Then\n      Number_of_Words = Number_of_Words + 1\n  End If\n\r\nNext Current_Character\n\nEnd Function\r\n"]
[null,"Create Acronym From Text String","\nFunction Acroymn (Original_String As String) As String\nDim Trimmed_String As String\r\nDim Length As Integer\r\nDim Pos As Integer\r\n\nTrimmed_String = Application.WorksheetFunction.Trim(Original_String)\r\n\r\n'work out the length of the string\r\nLength = Len(Trimmed_String)\r\n\r\nAcroymn = UCase(Left(Trimmed_String, 1))\r\n\nFor Pos = 2 To Length - 1\r\n    If (Mid(Trimmed_String, Pos, 1) = \" \") Then\r\n    Acroymn = Acroymn & UCase(Mid(Trimmed_String, Pos + 1, 1))\r\n    End If\r\nNext Pos\r\n\nEnd Function\r\n"]
[null,"Extract Numbers from String","\nFunction Extract_Number_from_Text(Phrase As String) As Double\n\nDim Length_of_String As Integer\nDim Current_Pos As Integer\nDim Temp As String\n\nLength_of_String = Len(Phrase)\nTemp = \"\"\n\nFor Current_Pos = 1 To Length_of_String\n\n  If (Mid(Phrase, Current_Pos, 1) = \"-\") Then\n    Temp = Temp & Mid(Phrase, Current_Pos, 1)\n  End If\n\n  If (Mid(Phrase, Current_Pos, 1) = \".\") Then\n    Temp = Temp & Mid(Phrase, Current_Pos, 1)\n  End If\n\n  If (IsNumeric(Mid(Phrase, Current_Pos, 1))) = True Then\n    Temp = Temp & Mid(Phrase, Current_Pos, 1)\n  End If\n\nNext Current_Pos\n\nIf Len(Temp) = 0 Then\n    Extract_Number_from_Text = 0\nElse\n    Extract_Number_from_Text = CDbl(Temp)\nEnd If\n\nEnd Function"]
[null,"Find Text in String","\nPublic Sub FindSomeText()\n\nIf InStr(\"Look in this string\", \"look\") = 0 Then\n   MsgBox \"woops, no match\"\nElse\n   MsgBox \"at least one match\"\nEnd If\n\nEnd Sub"]
[null,"Force Proper Case","\nPrivate Sub Worksheet_Change(ByVal Target As Excel.Range)\n\nApplication.EnableEvents = False\n\nIf Target.Column = 5 Then\n  Target = StrConv(Target, vbProperCase)\nEnd If\n\nApplication.EnableEvents = True\nEnd Sub"]
[null,"Loop Through Each Character in Text String","\nSub LoopThroughString()\n\nDim Counter As Integer\nDim MyString As String\nMyString = \"AutomateExcel\" 'define string\n\r\nFor Counter = 1 To Len(MyString)\n    'do something to each character in string\n    'here we'll msgbox each character\n    MsgBox Mid(MyString, Counter, 1)\nNext\n\nEnd Sub\r\n"]
[null,"Return nth Word","\nFunction Find_nth_word(Phrase As String, n As Integer) As String\n\nDim Current_Pos As Long\nDim Length_of_String As Integer\nDim Current_Word_No As Integer\n\nFind_nth_word = \"\"\nCurrent_Word_No = 1\n\n'Remove Leading Spaces\nPhrase = Trim(Phrase)\n\nLength_of_String = Len(Phrase)\n\nFor Current_Pos = 1 To Length_of_String\n    If (Current_Word_No = n) Then\n        Find_nth_word = Find_nth_word & Mid(Phrase, Current_Pos, 1)\n    End If\n    If (Mid(Phrase, Current_Pos, 1) = \" \") Then\n     Current_Word_No = Current_Word_No + 1\n    End If\nNext Current_Pos\n\n'Remove the rightmost space\nFind_nth_word = Trim(Find_nth_word)\n\nEnd Function\r\n"]
[null,"Reverse a Text String","\nOption Explicit\r\nPrivate Sub CommandButton1_Click()\r\n\r\n'Define Variables\r\n\r\nDim Original_String As String\r\nDim Reversed_String As String\r\nDim Next_Char As String\r\n\r\nDim Length As Integer\r\nDim Pos As Integer\r\n\r\n'Get the Original String\r\n\r\nOriginal_String = InputBox(\"Pls enter the original string: \")\r\n\r\n'Find the revised length of the string\r\n\r\nLength = Len(Original_String)\r\n\r\n'Set up the reversed string\r\nReversed_String = \"\"\r\n\r\n'Progress through the string on a character by character basis\r\n'Starting at the last character and going towards the first character\r\n\r\nFor Pos = Length To 1 Step -1\r\n\r\n    Next_Char = Mid(Original_String, Pos, 1)\r\n    Reversed_String = Reversed_String & Next_Char\r\nNext Pos\r\n\r\nMsgBox \"The reversed string is \" & Reversed_String\r\n\r\nEnd Sub\r\n"]
[null,"Speak a String of Text","\nSub SayThisString()\n\nDim SayThis As String\n\nSayThis = \"I love Microsoft Excel\"\nApplication.Speech.Speak (SayThis)\n\nEnd Sub"]
[null,"Spellcheck","\nPrivate Sub Workbook_BeforeClose(Cancel As Boolean)\n\nSheet1.Cells.CheckSpelling\n\nEnd Sub"]
[null,"Trim Characters From Left","\nmsgbox Right(Mystring, 9)"]
[null,"Trim Characters From Right","\nMsgBox Right(Mystring, Len(Mystring) - 1)"]
[]
["Workbooks","Copy (Cut) and Paste to Another Workbook","\nSub Paste_Other_Sheet_or_Book()\n\n'Cut or Copy and Paste to another worksheet\nWorksheets(\"sheet1\").Range(\"A1\").Copy Worksheets(\"sheet2\").Range(\"B1\") 'Copy\nWorksheets(\"sheet1\").Range(\"A1\").Cut Worksheets(\"sheet2\").Range(\"B1\") 'Cut\n\n'Cut or Copy and Paste to another workbook\nWorkbooks(\"book1.xlsm\").Worksheets(\"sheet1\").Range(\"A1\").Copy _ \nWorkbooks(\"book2.xlsm\").Worksheets(\"sheet1\").Range(\"B1\") 'Copy\nWorkbooks(\"book1.xlsm\").Worksheets(\"sheet1\").Range(\"A1\").Cut _ \nWorkbooks(\"book2.xlsm\").Worksheets(\"sheet1\").Range(\"B1\") 'Cut\n\nApplication.CutCopyMode = False\n\nEnd Sub"]
[null,"Force Workbook to Save","\nPrivate Sub Workbook_BeforeClose(Cancel As Boolean)\n\nIf Saved = False Then\n    ActiveWorkbook.Save\nEnd If\n\nEnd Sub"]
[null,"List All worksheets in Workbook","\nSub ListSheets()\r\nDim ws As Worksheet\r\nDim x As Integer\r\n\r\nx = 1\r\n\r\nSheets(\"Sheet1\").Range(\"A:A\").Clear\r\n\r\nFor Each ws In Worksheets\r\n     Sheets(\"Sheet1\").Cells(x, 1) = ws.Name\r\n     x = x + 1\r\nNext ws\r\n\r\nEnd Sub\r\n"]
[null,"Save Worksheet as New Workbook and Email","\nSub Mail_Workbook()\n\nApplication.DisplayAlerts = False\nApplication.enableevents = False\nApplication.ScreenUpdating = False\nApplication.Calculation = xlCalculationManual\nDim OutApp As Object\nDim OutMail As Object\nDim FilePath As String\nDim Project_Name As String\nDim Template_Name As String\nDim ReviewDate As String\nDim SaveLocation As String\nDim Path As String\nDim Name As String\n\r\n'Create Initial variables\nSet OutApp = CreateObject(\"Outlook.Application\")\nSet OutMail = OutApp.CreateItem(0)\nProject_Name = Sheets(\"sheet1\").Range(\"ProjectName\").Value\nTemplate_Name = ActiveSheet.Name\n\r\n'Ask for Input used in Email\nReviewDate = InputBox(Prompt:=\"Provide date by when you'd like the submission reviewed.\", Title:=\"Enter Date\", Default:=\"MM/DD/YYYY\")\n\nIf ReviewDate = \"Enter Date\" Or ReviewDate = vbNullString Then GoTo endmacro\n\r\n'Save Worksheet as own workbook\nPath = ActiveWorkbook.Path\n    Name = Trim(Mid(ActiveSheet.Name, 4, 99))\n\r\n\r\nSet ws = ActiveSheet\nSet oldWB = ThisWorkbook\n\r\nSaveLocation = InputBox(Prompt:=\"Choose File Name and Location\", Title:=\"Save As\", Default:=CreateObject(\"WScript.Shell\").SpecialFolders(\"Desktop\") & \"/\" & Name & \".xlsx\")\n\r\n    If Dir(SaveLocation) <> \"\" Then\n    MsgBox (\"A file with that name already exists. Please choose a new name or delete existing file.\")\n    SaveLocation = InputBox(Prompt:=\"Choose File Name and Location\", Title:=\"Save As\", Default:=CreateObject(\"WScript.Shell\").SpecialFolders(\"Desktop\") & \"/\" & Name & \".xlsx\")\n    End If\n    \r\nIf SaveLocation = vbNullString Then GoTo endmacro\n\n'unprotect sheet if needed\nActiveSheet.Unprotect Password:=\"password\"\n\nSet newWB = Workbooks.Add\n\r\n'Adjust Display\nActiveWindow.Zoom = 80\nActiveWindow.DisplayGridlines = False\n\n'Copy + Paste Values\noldWB.Activate\noldWB.ActiveSheet.Cells.Select\nSelection.Copy\nnewWB.Activate\nnewWB.ActiveSheet.Cells.Select\n\r\n    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _\n        :=False, Transpose:=False\n    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _\n        SkipBlanks:=False, Transpose:=False\n    Selection.PasteSpecial Paste:=xlPasteValidation, Operation:=xlNone, _\n        SkipBlanks:=False, Transpose:=False\n\n'Select new WB and turn off cutcopy mode\n    newWB.ActiveSheet.Range(\"A10\").Select\n    Application.CutCopyMode = False\n\n'Save File\n    newWB.SaveAs Filename:=SaveLocation, _\n        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False\n\nFilePath = Application.ActiveWorkbook.FullName\n    \r\n'Reprotect oldWB\noldWB.ActiveSheet.Protect Password:=\"password\", DrawingObjects:=True, Contents:=True, Scenarios:=True, _\n       AllowFormattingCells:=True, AllowFormattingColumns:=True, _\n       AllowFormattingRows:=True\n\n'Email\nOn Error Resume Next\nWith OutMail\n.to = \"email@email.com\"\n.CC = \"\"\n.BCC = \"\"\n.Subject = Project_Name & \": \" & Template_Name & \" for review\"\n.Body = \"Project Name: \" & Project_Name & \", \" & Name & \" For review by \" & ReviewDate\n.Attachments.Add (FilePath)\n.Display\n' .Send      'Optional to automate sending of email.\nEnd With\nOn Error GoTo 0\nSet OutMail = Nothing\nSet OutApp = Nothing\n\n'End Macro, Restore Screenupdating, Calcs, etc...\nendmacro:\nApplication.DisplayAlerts = True\nApplication.enableevents = True\nApplication.ScreenUpdating = True\nApplication.Calculation = xlCalculationAutomatic\n\nEnd Sub\r\n"]
[null,"Test if Workbook is Open","\nSub TestByWorkbookName()\nDim wb As Workbook\n\nFor Each wb In Workbooks\n'replace between the quotes with workbook to test for\n\n  If wb.Name = \"New Microsoft Excel Worksheet.xls\" Then\n        MsgBox \"Found it\"\n        Exit Sub 'call code here, we'll just exit for now\n  End If\n\nNext\r\n\nEnd Sub\r\n"]
[]
["Worksheets","Activate Sheet","\nsheets(\"mytabname\").activate"]
[null,"Count Worksheets","\nPublic Sub CountMySheets()\n\nMsgBox Application.Sheets.Count\n\nEnd Sub"]
[null,"Create Hyperlink Menu of Worksheets","Sub ListSheets()\nDim ws As Worksheet\nDim x As Integer\n\nx = 1\n\nSheets(\"Sheet1\").Range(\"A:A\").Clear\r\n\r\nFor Each ws In Worksheets\n   Sheets(\"Sheet1\").Cells(x, 1).Select\n   ActiveSheet.Hyperlinks.Add _\n   Anchor:=Selection, Address:=\"\", SubAddress:= _\n   ws.Name & \"!A1\", TextToDisplay:=ws.Name\n  x = x + 1\nNext ws\n\nEnd Sub\r\n"]
[null,"Create Worksheets From List of Names","\nFunction Sheet_Exists(WorkSheet_Name As String) As Boolean\n\nDim Work_sheet As Worksheet\nSheet_Exists = False\nFor Each Work_sheet In ThisWorkbook.Worksheets\n    If Work_sheet.Name = WorkSheet_Name Then\n        Sheet_Exists = True\n    End If\nNext\n\nEnd Function\r\n"]
[null,"Hide Worksheet Tabs","\nSub Hide_Tabs\n\n'Hide sheet tabs\nActiveWindow.DisplayWorkbookTabs = False\n\nEnd Sub "]
[null,"List All worksheets in Workbook","\nSub ListSheets()\r\nDim ws As Worksheet\r\nDim x As Integer\r\n\r\nx = 1\r\n\r\nSheets(\"Sheet1\").Range(\"A:A\").Clear\r\n\r\nFor Each ws In Worksheets\r\n     Sheets(\"Sheet1\").Cells(x, 1) = ws.Name\r\n     x = x + 1\r\nNext ws\r\n\r\nEnd Sub\r\n"]
[null,"Loop Through Each Sheet in Workbook","\nFor Each ws In Worksheets\n  'Update or do something here\nNext"]
[null,"Save Worksheet as New Workbook and Email","\nSub Mail_Workbook()\n\nApplication.DisplayAlerts = False\nApplication.enableevents = False\nApplication.ScreenUpdating = False\nApplication.Calculation = xlCalculationManual\nDim OutApp As Object\nDim OutMail As Object\nDim FilePath As String\nDim Project_Name As String\nDim Template_Name As String\nDim ReviewDate As String\nDim SaveLocation As String\nDim Path As String\nDim Name As String\n\r\n'Create Initial variables\nSet OutApp = CreateObject(\"Outlook.Application\")\nSet OutMail = OutApp.CreateItem(0)\nProject_Name = Sheets(\"sheet1\").Range(\"ProjectName\").Value\nTemplate_Name = ActiveSheet.Name\n\r\n'Ask for Input used in Email\nReviewDate = InputBox(Prompt:=\"Provide date by when you'd like the submission reviewed.\", Title:=\"Enter Date\", Default:=\"MM/DD/YYYY\")\n\nIf ReviewDate = \"Enter Date\" Or ReviewDate = vbNullString Then GoTo endmacro\n\r\n'Save Worksheet as own workbook\nPath = ActiveWorkbook.Path\n    Name = Trim(Mid(ActiveSheet.Name, 4, 99))\n\r\n\r\nSet ws = ActiveSheet\nSet oldWB = ThisWorkbook\n\r\nSaveLocation = InputBox(Prompt:=\"Choose File Name and Location\", Title:=\"Save As\", Default:=CreateObject(\"WScript.Shell\").SpecialFolders(\"Desktop\") & \"/\" & Name & \".xlsx\")\n\r\n    If Dir(SaveLocation) <> \"\" Then\n    MsgBox (\"A file with that name already exists. Please choose a new name or delete existing file.\")\n    SaveLocation = InputBox(Prompt:=\"Choose File Name and Location\", Title:=\"Save As\", Default:=CreateObject(\"WScript.Shell\").SpecialFolders(\"Desktop\") & \"/\" & Name & \".xlsx\")\n    End If\n    \r\nIf SaveLocation = vbNullString Then GoTo endmacro\n\n'unprotect sheet if needed\nActiveSheet.Unprotect Password:=\"password\"\n\nSet newWB = Workbooks.Add\n\r\n'Adjust Display\nActiveWindow.Zoom = 80\nActiveWindow.DisplayGridlines = False\n\n'Copy + Paste Values\noldWB.Activate\noldWB.ActiveSheet.Cells.Select\nSelection.Copy\nnewWB.Activate\nnewWB.ActiveSheet.Cells.Select\n\r\n    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _\n        :=False, Transpose:=False\n    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _\n        SkipBlanks:=False, Transpose:=False\n    Selection.PasteSpecial Paste:=xlPasteValidation, Operation:=xlNone, _\n        SkipBlanks:=False, Transpose:=False\n\n'Select new WB and turn off cutcopy mode\n    newWB.ActiveSheet.Range(\"A10\").Select\n    Application.CutCopyMode = False\n\n'Save File\n    newWB.SaveAs Filename:=SaveLocation, _\n        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False\n\nFilePath = Application.ActiveWorkbook.FullName\n    \r\n'Reprotect oldWB\noldWB.ActiveSheet.Protect Password:=\"password\", DrawingObjects:=True, Contents:=True, Scenarios:=True, _\n       AllowFormattingCells:=True, AllowFormattingColumns:=True, _\n       AllowFormattingRows:=True\n\n'Email\nOn Error Resume Next\nWith OutMail\n.to = \"email@email.com\"\n.CC = \"\"\n.BCC = \"\"\n.Subject = Project_Name & \": \" & Template_Name & \" for review\"\n.Body = \"Project Name: \" & Project_Name & \", \" & Name & \" For review by \" & ReviewDate\n.Attachments.Add (FilePath)\n.Display\n' .Send      'Optional to automate sending of email.\nEnd With\nOn Error GoTo 0\nSet OutMail = Nothing\nSet OutApp = Nothing\n\n'End Macro, Restore Screenupdating, Calcs, etc...\nendmacro:\nApplication.DisplayAlerts = True\nApplication.enableevents = True\nApplication.ScreenUpdating = True\nApplication.Calculation = xlCalculationAutomatic\n\nEnd Sub\r\n"]
[null,"Select all Cells in Worksheet","\nSub MySelectAll()\n\n  Sheet1.Activate\n  Sheet1.Cells.Select\n\nEnd Sub"]
[null,"Select Sheet","\nSheets(\"TabNameGoesHere\").Select"]
[null,"Set the Default Sheet When a WorkBook Opens","Private Sub Workbook_Open()\n\nSheets(\"mytabname\").Activate\n\nEnd Sub"]
[null,"Set Zoom Percentage for all Worksheets","\nSub ZoomAll()\n\nDim ws As Worksheet\n\nFor Each ws In Worksheets\n    ws.Activate\n    ActiveWindow.Zoom = 50\nNext\n\nEnd Sub"]
[null,"Sort Sheets Alphabetically","\nSub Sort_Sheets()\n\nDim Sort_Mode_Descending As Boolean\nDim No_of_Sheets As Integer\nDim Outer_Loop As Integer\nDim Inner_Loop As Integer\n\nNo_of_Sheets = Sheets.Count\n\n'Change Flag As appropriate\nSort_Mode_Descending = False\n\nFor Outer_Loop = 1 To No_of_Sheets\n  For Inner_Loop = 1 To Outer_Loop\n    If Sort_Mode_Descending = True Then\n      If UCase(Sheets(Outer_Loop).Name) > UCase(Sheets(Inner_Loop).Name) Then\n        Sheets(Outer_Loop).Move Before:=Sheets(Inner_Loop)\n      End If\n    End If\n    If Sort_Mode_Descending = False Then\n      If UCase(Sheets(Outer_Loop).Name) < UCase(Sheets(Inner_Loop).Name) Then\n        Sheets(Outer_Loop).Move Before:=Sheets(Inner_Loop)\n      End If\n        End If\n\n  Next Inner_Loop\nNext Outer_Loop\n\nEnd Sub\r\n"]
[null,"Unhide All Worksheets","\nSub UnhideAll()\nDim WS As Worksheet\n\nFor Each WS In Worksheets\n     WS.Visible = True\nNext\n\nEnd Sub"]
[null,"Worksheet - Hide","\nSub SheetHide ()\n\nworksheets(\"sheet1\").visible = false\n\nend sub"]
[null,"Worksheet - Unhide","\nSub SheetUnhide()\nSheet1.Visible = xlSheetVisible\r\n\nEnd Sub\r\n"]
[null,"Worksheet - VeryHidden","\nSub SheetVerryHidden()\n\nSheet1.Visible = xlSheetVeryHidden\n\nEnd Sub"]