Making The Most Of The Quick Access Toolbar In Excel

The e-book Making The Most Of The Quick Access Toolbar In Excel is now available to download now on Amazon:

https://amzn.to/3JSl1My

Making The Most Of The Quick Access Toolbar In Excel

For any questions on the book please email me at support@integralexcel.net


Customization file with no macros included

Use the following code to set up your own *.exportedUI file for the Model QAT in Chapter Five. If you plan to add the macros, first install the macro code in your personal.xlsb or a macro enabled *.xlsm file (see Macro Code further below), by following the directions in Chapter Four.

Copy the following code to your clipboard to create your own file. Or click here to download a copy of the file from this website.

<mso:cmd app="Excel" dt="1" /><mso:customUI xmlns:x1="PowerPivotExcelClientAddIn.NativeEntry.1" xmlns:msox="http://schemas.microsoft.com/office/2006/01/customui/special" xmlns:mso="http://schemas.microsoft.com/office/2009/07/customui"><mso:ribbon><mso:qat><mso:sharedControls><mso:control idQ="mso:AutoSaveSwitch" visible="false"/><mso:control idQ="mso:FileNewDefault" visible="false"/><mso:control idQ="mso:FileSendAsAttachment" visible="false" insertBeforeQ="mso:FileOpenUsingBackstage"/><mso:control idQ="mso:FilePrintQuick" visible="false" insertBeforeQ="mso:FileOpenUsingBackstage"/><mso:control idQ="mso:PrintPreviewAndPrint" visible="false" insertBeforeQ="mso:FileOpenUsingBackstage"/><mso:control idQ="mso:Spelling" visible="false" insertBeforeQ="mso:FileOpenUsingBackstage"/><mso:control idQ="mso:SortAscendingExcel" visible="false" insertBeforeQ="mso:FileOpenUsingBackstage"/><mso:control idQ="mso:SortDescendingExcel" visible="false" insertBeforeQ="mso:FileOpenUsingBackstage"/><mso:control idQ="mso:PointerModeOptions" visible="false" insertBeforeQ="mso:FileOpenUsingBackstage"/><mso:control idQ="mso:FileCloseAll" visible="true" insertBeforeQ="mso:FileOpenUsingBackstage"/><mso:separator idQ="msox:sep12" visible="true" insertBeforeQ="mso:FileOpenUsingBackstage"/><mso:control idQ="mso:FileOpenUsingBackstage" visible="true"/><mso:control idQ="mso:FileSave" visible="true"/><mso:control idQ="mso:FileSaveAs" visible="true" insertBeforeQ="mso:Undo"/><mso:control idQ="mso:FileClose" visible="true" insertBeforeQ="mso:Undo"/><mso:control idQ="mso:Undo" visible="true"/><mso:control idQ="mso:Redo" visible="true"/><mso:separator idQ="msox:sep11" visible="true"/><mso:control idQ="mso:WindowSwitchWindowsMenuExcel" visible="true"/><mso:control idQ="mso:WindowUnhide" visible="true"/><mso:control idQ="mso:WindowHide" visible="true"/><mso:control idQ="mso:GroupWindow" visible="true"/><mso:control idQ="mso:ViewFullScreenView" visible="true"/><mso:separator idQ="msox:sep9" visible="true"/><mso:control idQ="mso:SheetMoveOrCopy" visible="true"/><mso:control idQ="mso:LeaveReader" visible="true"/><mso:control id="mso_c1.1E1BC28" visible="true"/><mso:separator idQ="msox:sep5" visible="true"/><mso:control idQ="mso:Filter" visible="true"/><mso:control idQ="mso:SortClear" visible="true"/><mso:control idQ="mso:SelectCurrentRegion" visible="true"/><mso:control idQ="mso:TableSelectVisibleCells" visible="true"/><mso:control idQ="mso:Copy" visible="true"/><mso:control idQ="mso:FillDown" visible="true"/><mso:separator idQ="msox:sep4" visible="true"/><mso:control idQ="mso:CellFillColorPicker" visible="true"/><mso:control idQ="mso:FontColorPicker" visible="true"/><mso:control idQ="mso:BordersGallery" visible="true"/><mso:control idQ="mso:BorderErase" visible="true"/><mso:control idQ="mso:GroupAlignmentExcel" visible="true"/></mso:sharedControls></mso:qat><mso:tabs><mso:tab idQ="mso:TabBackgroundRemoval" visible="false"/><mso:tab idQ="mso:TabDeveloper"><mso:group idQ="mso:GroupXml" visible="false"/></mso:tab><mso:tab idQ="mso:HelpTab"><mso:group idQ="mso:GroupXml"/></mso:tab><mso:tab idQ="x1:tabPowerPivot" visible="false"/></mso:tabs><mso:contextualTabs><mso:tabSet idMso="TabSetSparkline"><mso:tab idQ="mso:TabSparklineDesign"><mso:group idQ="mso:GroupSparklineDataEdit" visible="false"/></mso:tab></mso:tabSet></mso:contextualTabs></mso:ribbon></mso:customUI>

Click here to download a PDF with all the following VBA code modules.

Module: functions


Sub insert_vlookup()
Selection.FormulaR1C1 = "=IFERROR(VLOOKUP(RC1,C1:C" & _
ActiveCell.Column & " ," & ActiveCell.Column & ",0)," & Chr(34) & Chr(34) _
& ")"
End Sub
 
Sub insert_link()
Selection.FormulaR1C1 = "=hyperlink(" & Chr(34) & Chr(34) & "," & _
Chr(34) & Chr(34) & ")"
End Sub
 
Sub text_upper()
ActiveCell = UCase(ActiveCell.Value)
End Sub
 
Sub text_lower()
ActiveCell = LCase(ActiveCell.Value)
End Sub
 
Sub is_number()
Selection.FormulaR1C1 = "=IF(ISNUMBER(RC[-1]), RC[-1], " & Chr(34) & _
Chr(34) & ")"
End Sub

Module: nextwindow

Sub next_window()
Application.ActiveWindow.ActivateNext
End Sub

Module: paste_visiblecells

Sub paste_visible_cells()
Dim current_cell, this_area As Range
Dim count As Integer
count = 0
Set this_area = Selection
Application.Calculation = xlManual
For Each current_cell In this_area
    If current_cell.Rows.Hidden = False Then
    current_cell.FormulaR1C1 = current_cell.Value
    End If
    count = count + 1
    If count > 100000 Then
    Exit Sub
    End If
Next
Application.Calculation = xlAutomatic
End Sub

Module: quicktrim

Sub quick_trim()
Application.Calculation = xlManual
Dim this_area, this_cell As Range
Dim old_value, new_value As String
Dim count As Integer
count = 0
Set this_area = Selection
For Each this_cell In this_area
this_cell.Value = Trim(this_cell)
count = count + 1
    If count > 100000 Then
        Exit Sub
    End If
Next
Application.Calculation = xlAutomatic
End Sub

Module: RAG

Sub rag_green()
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 10092288
End With
End Sub

Sub rag_amber()
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 49407
End With
End Sub

Sub rag_red()
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 8420607
End With

End Sub
Sub rag_clear()
With Selection.Interior
    .Color = xlNone
End With
End Sub

Module: select_nextto

Sub select_next_to()
Dim top_cell As Range
Set top_cell = ActiveCell
ActiveCell.Offset(0, -1).Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Select
Range(Selection, top_cell).Select
End Sub

Module: sendto

Dim targetbook As String
Dim sendtab As String
Dim sendbook As String
Dim message, msg_content As String
Sub send()
sendtab = ActiveSheet.Name
sendbook = ActiveWorkbook.Name
If targetbook = "" Then
    msg_content = "To use this macro, you must first " & _
    "set a target workbook with send_set()."
    message = MsgBox(msg_content, vbOKCancel, "Macro: send( )")
    Exit Sub
End If
Workbooks(sendbook).Activate
Sheets(sendtab).Move after:=Workbooks(targetbook). _
Sheets(Workbooks(targetbook).Sheets.Count)
End Sub
Sub send_set()
msg_content = ActiveWorkbook.Name & " is selected. " & _
"Click OK to set this as the target for the send macro " & _
"or Cancel to exit."
message = MsgBox(msg_content, vbOKCancel, "Macro: send_set( )")
Select Case message
Case vbOK
    targetbook = ActiveWorkbook.Name
    Workbooks(targetbook).Activate
End Select
End Sub

Module: unhide_worksheets

Sub worksheets_unhide()
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name <> ActiveSheet.Name Then
    ws.Visible = xlSheetVisible
End If
Next ws
End Sub

Module: zoom

Dim zoom_status As Boolean
Dim thissheet As String
Dim w As Worksheet
Sub zoom_workbook()
ActiveWorkbook.Activate
thissheet = ActiveSheet.Name
For Each w In Worksheets
    w.Activate
    If w.Visible = True Then
        If zoom_status = False Then
        ActiveWindow.zoom = 80
        Else
        ActiveWindow.zoom = 100
        End If
    End If
Next w
If zoom_status = False Then
    zoom_status = True
Else
    zoom_status = False
End If
ActiveWorkbook.Sheets(thissheet).Select
End Sub

Trademarks: Microsoft and Excel are trademarks of the Microsoft group of companies.

Disclaimer: While the author has endeavored to make sure the contents of this website are as accurate and up to date as possible, he accepts no liability or responsibility for any error, damage or loss resulting from your use of the information and code contained within it.