├── README.md
├── images
├── README.MD
└── macro_ribbon_and_config.png
└── macros
├── better_autofilter.bas
├── check_for_errors.bas
├── check_for_formulas.bas
├── comma_separate_selection.bas
├── filter_by_selection.bas
├── filter_out_selection.bas
├── format_top_row.bas
├── kill_external_formulas.bas
├── number_format.bas
├── scotts_macros_all.bas
├── select_uniques.bas
└── top_left_active_cell.bas
/README.md:
--------------------------------------------------------------------------------
1 | # Useful VBA Macros to Supercharge Microsoft Excel
2 | Become a Microsoft Excel power user with these handy VBA macros. I've been using and fine-tuning these for years to help make my day-to-day tasks more efficient. Take them and make them your own. You can download the whole collection at [/macros/scotts_macros_all.bas](/macros/scotts_macros_all.bas). If you're new to VBA and Excel macros you'll want to read my notes on [getting started](#how-to-get-started). Be sure to add these as commands/buttons to Excel's `HOME` ribbon to really make them useful!
3 |
4 | # Contents
5 | * [*How to get started*](#how-to-get-started)
6 | * [*Notes and Caveats*](#macro-notes--caveats)
7 | * [Format Top Row of your table](#format-top-row)
8 | * [Better number format](#better-number-format)
9 | * [Better AutoFilter](#better-autofilter)
10 | * [Check worksheet for formulas](#formula-check)
11 | * [Check worksheet for #N/As](#na-check)
12 | * [Filter table for selected cell](#filter-for-only-selected)
13 | * [Filter table and remove selected cell](#filter-out-remove-selected)
14 | * [Reset active cell to top left for all sheets in workbook](#reset-active-cell-to-top-left-for-all-sheets-in-workbook)
15 | * [Remove external links](#remove-external-links)
16 | * [Select Uniques (by removing duplicates from selection)](#select-uniques)
17 | * [Comma Separate Selection](#comma-separate-selection)
18 |
19 |
20 |
21 | ## Format Top Row
22 | This may be my most-used macro. In one click it format the table header and freeze the top pane. It makes tables a lot easier on the eyes and knows exactly what to format.
23 |
24 | ```bas
25 | 'Purpose: Freezes and formats the top row of your table to make it easier to look at and work with
26 | 'Active sheet only
27 | Dim toprow As Range
28 | 'If there's <=1 used cell in row 1 then check if the active cell is inside the table to format
29 | If Application.WorksheetFunction.CountA(Range("1:1")) > 1 Then
30 | Set toprow = Range("A1:" & Range("IV1").End(xlToLeft).Address)
31 | Else
32 | Dim tbl As Range
33 | Set tbl = Selection.CurrentRegion
34 | 'If the active cell is not inside of a table then inform user and end macro
35 | If tbl.Count = 1 Then
36 | MsgBox "Couldn't find a table to format! Click a cell in the table and run again", vbExclamation, "Couldn't find table!"
37 | Exit Sub
38 | End If
39 | Dim firstcell As Range
40 | Set firstcell = tbl.Cells(1, 1)
41 | Set toprow = Range(firstcell, firstcell.Offset(0, tbl.Columns.Count - 1))
42 | End If
43 | Cells(toprow.Row + 1, 1).Select
44 | ActiveWindow.FreezePanes = False
45 | ActiveWindow.FreezePanes = True
46 | 'Sets a grey background with white bold text
47 | With toprow.Interior
48 | .Pattern = xlSolid
49 | .PatternColorIndex = xlAutomatic
50 | .ThemeColor = xlThemeColorDark2
51 | .TintAndShade = -0.249977111117893
52 | .PatternTintAndShade = 0
53 | End With
54 | toprow.Font.Bold = True
55 | toprow.Font.Color = vbWhite
56 | ```
57 | [➥full code](/macros/format_top_row.bas)
58 |
59 | ## Better Number Format
60 | I usually want my numbers formatted like this: `452,199`
61 | Not like this: `452199`
62 | Not like this: `452,199.00`
63 | And not like this: `|_____452,199|` (right justified)
64 |
65 | This means centered, with a comma separator, and no decimals. Crazily, the only way to do this is with many clicks (I think 8 is the least) through the `Format Cells` dialog. FTFY:
66 |
67 | ```bas
68 | Selection.NumberFormat = "#,##0"
69 | Selection.HorizontalAlignment = xlCenter
70 | ```
71 | [➥full code](/macros/number_format.bas)
72 |
73 | ## Better AutoFilter
74 | I filter my tables a lot, so I made one button that enables auto-filter on a table, clears any existing filters, and shuts auto-filter. It cuts down on clicks and is really how the auto-filter button should work.
75 |
76 | ```bas
77 | On Error Resume Next
78 | If ActiveSheet.FilterMode = True Then
79 | ActiveSheet.ShowAllData
80 | Else
81 | Selection.AutoFilter
82 | End If
83 | ```
84 | [➥full code](/macros/better_autofilter.bas)
85 |
86 | ## Formula Check
87 | With a single click this macro will select all cells containing a formula on the active sheet. This is useful if you’re going to publish or share a spreadsheet and want the values hard coded. After running it, you can look at the status bar (bottom right) to see how many cells/formulas are selected.
88 |
89 | ```bas
90 | On Error GoTo err
91 | Cells.SpecialCells(xlCellTypeFormulas).Select
92 | Exit Sub
93 | err:
94 | If err.Number = 1004 Then MsgBox "No Formulas Here!"
95 | ```
96 | [➥full code](/macros/check_for_formulas.bas)
97 |
98 | ## #N/A Check
99 | Don’t be the guy or gal that sends out spreadsheets with `#N/A` all over it. Use this macro to highlight all of these in your current tab. It will catch other types of error cells too, like `DIV/0!`. You can prevent errored formulas by wrapping your formula in an `iferror(your_formula,value_if_error)`. After running it, you can look at the status bar (bottom right) to see how many cells/#NAs are selected.
100 |
101 | ```bas
102 | On Error GoTo err
103 | Cells.SpecialCells(xlCellTypeFormulas, xlErrors).Select
104 | Exit Sub
105 | err:
106 | If err.Number = 1004 Then MsgBox "No Errors Here!"
107 | ```
108 | [➥full code](/macros/check_for_errors.bas)
109 |
110 | ## Filter for ONLY Selected
111 | I was using this macro before it was built into Excel. It will filter your table and show you just values of the cell you have selected. Alternatively, you can right click on the cell and go to `Filter` → `Filter by Selected Cell’s Value`
112 |
113 | ```bas
114 | 'Can be used multiple times on multiple columns
115 | 'Only filters one cell so select first cell cell if multiple are selected
116 | If Selection.Count > 1 Then ActiveCell.Select
117 | 'Check for existing filter
118 | If ActiveSheet.AutoFilterMode = False Then Selection.AutoFilter
119 | 'Autofilter uses column number relative to the table
120 | filtercolumn = ActiveCell.Column - ActiveSheet.AutoFilter.Range.Column + 1
121 | 'Check for error cell
122 | If IsError(Selection.Value) Then cellvalue = Selection.Text Else cellvalue = Selection.Value
123 | 'Filter
124 | Selection.AutoFilter Field:=filtercolumn, Criteria1:="=" & cellvalue
125 | ```
126 | [➥full code](/macros/filter_by_selection.bas)
127 |
128 | ## Filter out (remove) Selected
129 | This does the opposite of above and filters out or removes only the selected value from your table. For instance, say you have a list of orders and want to remove all orders with a $0 value. Just click $0 in the table and then run this macro.
130 |
131 | ```bas
132 | 'Can be used multiple times multiple columns
133 | 'Only filters one cell so select first cell cell if multiple are selected
134 | If Selection.Count > 1 Then ActiveCell.Select
135 | 'Check for existing filter
136 | If ActiveSheet.AutoFilterMode = False Then Selection.AutoFilter
137 | 'Autofilter uses column number relative to the table
138 | filtercolumn = ActiveCell.Column - ActiveSheet.AutoFilter.Range.Column + 1
139 | 'Check for error cell
140 | If IsError(Selection.Value) Then cellvalue = Selection.Text Else cellvalue = Selection.Value
141 | 'Filter
142 | Selection.AutoFilter Field:=filtercolumn, Criteria1:="<>" & cellvalue, Operator:=xlAnd
143 | ```
144 | [➥full code](/macros/filter_out_selection.bas)
145 |
146 | ## Reset active cell to top left for all sheets in workbook
147 | This is a great feature if you share spreadsheets with a lot of tabs. It simply cycles through all your sheets placing the active cell on the top left. Useful when you're sharing spreadsheets
148 |
149 | ```bas
150 | Dim currsheet As Worksheet
151 | Dim sheet As Worksheet
152 | Set currsheet = ActiveSheet
153 | 'Change A1 to suit your preference
154 | Const TopLeft As String = "A1"
155 | 'Loop through all the sheets in the workbook
156 | For Each sheet In Worksheets
157 | 'Only does this for visible worksheets
158 | If sheet.Visible = xlSheetVisible Then Application.GoTo sheet.Range(TopLeft), scroll:=True
159 | Next sheet
160 | currsheet.Activate
161 | ```
162 | [➥full code](/macros/top_left_active_cell.bas)
163 |
164 | ## Remove External Links
165 | If you’re sharing spreadsheets and you occasionally reference other workbooks, this macro is a must. The macro gives you a few options for replacing external references with their values -- you can just remove external references in the selected cells, or the entire active worksheet, or the entire workbook. You can't undo this function so use with caution!
166 |
167 | ```bas
168 | 'Only applies to cells in selection
169 | Dim replaced As Integer
170 | replaced = 0
171 | wholebook = MsgBox("Do you want to Remove External Formulas from the whole WORKBOOK? Click no for active sheet or selection. You Can't Undo This!!", vbYesNoCancel + vbInformation, "Apply to whole WORKBOOK?")
172 | If wholebook = vbCancel Then Exit Sub
173 | If wholebook = vbNo Then
174 | wholesheet = MsgBox("Do you want to Remove External Formulas from the whole WORKSHEET? Click no if you just want to remove from the selection. You Can't Undo This!!", vbYesNoCancel, "Apply to whole WORKSHEET?")
175 | If wholesheet = vbCancel Then Exit Sub
176 | If wholesheet = vbYes Then ActiveSheet.UsedRange.Select
177 | For Each cell In Selection
178 | If InStr(cell.Formula, "!") > 0 Then
179 | cell.Value = cell.Value
180 | replaced = replaced + 1
181 | End If
182 | Next cell
183 | Else
184 | For Each sheet In ActiveWorkbook.Worksheets
185 | For Each cell In sheet.UsedRange
186 | If InStr(cell.Formula, "!") > 0 Then
187 | cell.Value = cell.Value
188 | replaced = replaced + 1
189 | End If
190 | Next cell
191 | Next sheet
192 | End If
193 | MsgBox replaced & " formula(s) removed!"
194 | ```
195 | [➥full code](/macros/kill_external_formulas.bas)
196 |
197 | ## Select Uniques
198 | This can be achieved a few ways in Excel, but I like my way best :) It selects only unique values in your selection. There’s a number of use-cases here.
199 |
200 | ```bas
201 | 'Selection does not need to be a single range, but it does need to be on the same sheet.
202 | If Selection.Count > 5000 Then
203 | response = MsgBox("This could take a while", vbOKCancel + vbInformation)
204 | If response = vbCancel Then Exit Sub
205 | End If
206 | ReDim vals(Selection.Count)
207 | Dim uniques As Range
208 | 'Cycle through all values in selection
209 | For Each cell In Selection
210 | 'Skip blank cells and errored cells
211 | If Not IsError(cell) And Not IsEmpty(cell) Then
212 | 'Set first value
213 | If uniques Is Nothing Then
214 | Set uniques = cell
215 | vals(1) = cell.Value
216 | uniq_counter = 2
217 | End If
218 | 'Check each cell against previously set unique values
219 | For checker = 1 To uniq_counter - 1
220 | If vals(checker) = cell.Value Then Exit For
221 | If checker = uniq_counter - 1 Then
222 | Set uniques = Union(uniques, cell)
223 | vals(uniq_counter) = cell.Value
224 | uniq_counter = uniq_counter + 1
225 | End If
226 | Next checker
227 | End If
228 | Next cell
229 | 'Select unique range if it exists
230 | If Not uniques Is Nothing Then uniques.Select
231 | ```
232 | [➥full code](/macros/select_uniques.bas)
233 |
234 | ## Comma Separate Selection
235 | This is a really useful feature if you use SQL or use a BI tool that filters on comma separated values. It simply takes all of your cells in a selection and comma separates them into a near by cell. The macro will ask you if you want to wrap the values in quotes (for strings). It can be used with the `Select Uniques` macro to only comma separate unique values in a selection.
236 |
237 | ```bas
238 | Dim outputcell As Range
239 | Set outputcell = Range("IV1").End(xlToLeft).Offset(0, 1)
240 | 'Wrap comma separated values in quotes yes/no
241 | apos = MsgBox("Add apostrophes?", vbYesNo, "Add apostrophes and wrap selections in quotes?")
242 | If apos = vbYes Then apos = True Else apos = False
243 | For Each cell In Selection
244 | If cell.Value <> "" Then
245 | If apos = False Then outputcell.Value = outputcell.Value & cell.Value & ", "
246 | If apos = True Then outputcell.Value = outputcell.Value & "'" & cell.Value & "', "
247 | End If
248 | Next cell
249 | 'Removes trailing comma
250 | outputcell.Value = Left(outputcell.Value, Len(outputcell.Value) - 2)
251 | ```
252 | [➥full code](/macros/comma_separate_selection.bas)
253 |
254 | ## Macro Notes & Caveats:
255 | * There’s no undo for a macro! (Unless you program one in)
256 | * You need to get `PERSONAL.XLSB` working so the macros are always available. You also want to add these macros as buttons on your Ribbon. See next section for both.
257 | * Excel for Mac has come a really long way, but you can't currently choose a custom icon for Macros on your ribbon :(
258 | * These macros have been working like a charm for me, but there's always room for improvement.
259 | * If you're new to macros, you can learn a lot from recording yourself doing it and/or googling "VBA + thing-you're-trying-to-do". Recording macros is really useful but try to remove the fluff and absolutely references that it writes.
260 | * "Step Into" your macros to go line by line and see what's happening as it runs. You can drag variables or statements to the "Watch Window" to see how they're evaluated as you step through.
261 | * Try to change, tweak, add to these to make them more personalized for you!
262 | * If you copy and paste from above, be sure to wrap it in `Sub WhateverMacroYouWant()` and `End Sub`.
263 | * Find me on (LinkedIn)[https://www.linkedin.com/in/scottschaen/] and send me some feedback, or propose a file change by forking this project.
264 |
265 | ## How To Get Started:
266 | ### You need to create a "Personal Macro Workbook" so that **your macros are always available** when Excel is open.
267 |
268 | You can read the [Windows Documentation](https://support.office.com/en-gb/article/copy-your-macros-to-a-personal-macro-workbook-aa439b90-f836-4381-97f0-6e4c3f5ee566#OfficeVersion=Windows) or the [Mac Documentation](https://support.office.com/en-gb/article/copy-your-macros-to-a-personal-macro-workbook-aa439b90-f836-4381-97f0-6e4c3f5ee566#OfficeVersion=macOS) but the gist is this:
269 | a) Enable the Developer tab for your Excel ribbon
270 | b) Click `Record Macro` and choose to store the macro in "Personal Macro Workbook"
271 | c) `Stop Recording` the macro and click the `Visual Basic` button (or press altF11)
272 | d) On the project explorer (top left) find `PERSONAL.XLSB`, expand `Modules`, and that's where you want to store all of your macros. You can leave them all in `Module1` or separate them. I prefer less modules, but it doesn't make a huge difference. Remember to Save!
273 |
274 | ### When you have your macros saved in `PERSONAL.XLSB` you want to **customize the ribbon** and add them as commands/buttons there.
275 |
276 | **Windows:** Right click anywhere on the ribbon and select `Customize the Ribbon...`
277 | **Mac:** `Excel` → `Preferences` → `Ribbon & Toolbar`
278 |
279 |
280 | 
281 |
282 |
283 | (You can read about this in my 5 Stupid Easy Excel Tips)[https://github.com/ScottSchaen/stupid-easy-excel-tips/blob/master/README.md#5-customize-the-home-ribbon--load-it-up-with-only-useful-functions]
284 |
285 | **Happy Excelling,**
286 | **Scott**
287 |
--------------------------------------------------------------------------------
/images/README.MD:
--------------------------------------------------------------------------------
1 | Nothing to see here.
2 |
--------------------------------------------------------------------------------
/images/macro_ribbon_and_config.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/ScottSchaen/excel-vba-macros/e583cb2035f1386a5a75dab0386015110c225da1/images/macro_ribbon_and_config.png
--------------------------------------------------------------------------------
/macros/better_autofilter.bas:
--------------------------------------------------------------------------------
1 | Sub BetterAutoFilter()
2 | 'Purpose: One button that turns on autofilter (when off), clear the filter (when filtered), or shut autofilter (when on and not filtered)
3 | 'Requires more buttons and clicks otherwise
4 | On Error Resume Next
5 | If ActiveSheet.FilterMode = True Then
6 | ActiveSheet.ShowAllData
7 | Else
8 | Selection.AutoFilter
9 | End If
10 | End Sub
11 |
--------------------------------------------------------------------------------
/macros/check_for_errors.bas:
--------------------------------------------------------------------------------
1 | Sub CheckForNAs()
2 | 'Purpose: Check for #N/As in current sheet
3 | On Error GoTo err
4 | Cells.SpecialCells(xlCellTypeFormulas, xlErrors).Select
5 | Exit Sub
6 | err:
7 | If err.Number = 1004 Then MsgBox "No Errors Here!"
8 | End Sub
9 |
--------------------------------------------------------------------------------
/macros/check_for_formulas.bas:
--------------------------------------------------------------------------------
1 | Sub CheckForFormulas()
2 | 'Purpose: Check for formulas in current sheet
3 | On Error GoTo err
4 | Cells.SpecialCells(xlCellTypeFormulas).Select
5 | Exit Sub
6 | err:
7 | If err.Number = 1004 Then MsgBox "No Formulas Here!"
8 | End Sub
9 |
--------------------------------------------------------------------------------
/macros/comma_separate_selection.bas:
--------------------------------------------------------------------------------
1 | Sub CommaSeparateSelection()
2 | 'Purpose: Comma separates all cells in selection and outputs them to an unused adjacent cell
3 | 'Current sheet only
4 | Dim outputcell As Range
5 | Set outputcell = Range("IV1").End(xlToLeft).Offset(0, 1)
6 | 'Wrap comma separated values in quotes yes/no
7 | apos = MsgBox("Add apostrophes?", vbYesNo, "Add apostrophes and wrap selections in quotes?")
8 | If apos = vbYes Then apos = True Else apos = False
9 | For Each cell In Selection
10 | If cell.Value <> "" Then
11 | If apos = False Then outputcell.Value = outputcell.Value & cell.Value & ", "
12 | If apos = True Then outputcell.Value = outputcell.Value & "'" & cell.Value & "', "
13 | End If
14 | Next cell
15 | 'Removes trailing comma
16 | outputcell.Value = Left(outputcell.Value, Len(outputcell.Value) - 2)
17 | End Sub
18 |
--------------------------------------------------------------------------------
/macros/filter_by_selection.bas:
--------------------------------------------------------------------------------
1 | Sub FilterBySelection()
2 | 'Purpose: Filter for current cell in selection
3 | 'Can be used multiple times on multiple columns
4 | 'Only filters one cell so select first cell cell if multiple are selected
5 | If Selection.Count > 1 Then ActiveCell.Select
6 | 'Check for existing filter
7 | If ActiveSheet.AutoFilterMode = False Then Selection.AutoFilter
8 | 'Autofilter uses column number relative to the table
9 | filtercolumn = ActiveCell.Column - ActiveSheet.AutoFilter.Range.Column + 1
10 | 'Check for error cell
11 | If IsError(Selection.Value) Then cellvalue = Selection.Text Else cellvalue = Selection.Value
12 | 'Filter
13 | Selection.AutoFilter Field:=filtercolumn, Criteria1:="=" & cellvalue
14 | End Sub
15 |
--------------------------------------------------------------------------------
/macros/filter_out_selection.bas:
--------------------------------------------------------------------------------
1 | Sub FilterOutSelection()
2 | 'Purpose: Filter OUT (remove) selected cell from the selection
3 | 'Can be used multiple times multiple columns
4 | 'Only filters one cell so select first cell cell if multiple are selected
5 | If Selection.Count > 1 Then ActiveCell.Select
6 | 'Check for existing filter
7 | If ActiveSheet.AutoFilterMode = False Then Selection.AutoFilter
8 | 'Autofilter uses column number relative to the table
9 | filtercolumn = ActiveCell.Column - ActiveSheet.AutoFilter.Range.Column + 1
10 | 'Check for error cell
11 | If IsError(Selection.Value) Then cellvalue = Selection.Text Else cellvalue = Selection.Value
12 | 'Filter
13 | Selection.AutoFilter Field:=filtercolumn, Criteria1:="<>" & cellvalue, Operator:=xlAnd
14 | End Sub
15 |
--------------------------------------------------------------------------------
/macros/format_top_row.bas:
--------------------------------------------------------------------------------
1 | Sub FormatTopRow()
2 | 'Purpose: Freezes and formats the top row of your table to make it easier to look at and work with
3 | 'Active sheet only
4 | Dim toprow As Range
5 | 'If there's <=1 used cell in row 1 then check if the active cell is inside the table to format
6 | If Application.WorksheetFunction.CountA(Range("1:1")) > 1 Then
7 | Set toprow = Range("A1:" & Range("IV1").End(xlToLeft).Address)
8 | Else
9 | Dim tbl As Range
10 | Set tbl = Selection.CurrentRegion
11 | 'If the active cell is not inside of a table then inform user and end macro
12 | If tbl.Count = 1 Then
13 | MsgBox "Couldn't find a table to format! Click a cell in the table and run again", vbExclamation, "Couldn't find table!"
14 | Exit Sub
15 | End If
16 | Dim firstcell As Range
17 | Set firstcell = tbl.Cells(1, 1)
18 | Set toprow = Range(firstcell, firstcell.Offset(0, tbl.Columns.Count - 1))
19 | End If
20 | Cells(toprow.Row + 1, 1).Select
21 | ActiveWindow.FreezePanes = False
22 | ActiveWindow.FreezePanes = True
23 | 'Sets a grey background with white bold text
24 | With toprow.Interior
25 | .Pattern = xlSolid
26 | .PatternColorIndex = xlAutomatic
27 | .ThemeColor = xlThemeColorDark2
28 | .TintAndShade = -0.249977111117893
29 | .PatternTintAndShade = 0
30 | End With
31 | toprow.Font.Bold = True
32 | toprow.Font.Color = vbWhite
33 | End Sub
34 |
--------------------------------------------------------------------------------
/macros/kill_external_formulas.bas:
--------------------------------------------------------------------------------
1 | Sub KillExternalFormulas()
2 | 'Purpose: Replaces external formulas that link to other workbooks with their values
3 | 'Only applies to cells in selection
4 | Dim replaced As Integer
5 | replaced = 0
6 | wholebook = MsgBox("Do you want to Remove External Formulas from the whole WORKBOOK? Click no for active sheet or selection. You Can't Undo This!!", vbYesNoCancel + vbInformation, "Apply to whole WORKBOOK?")
7 | If wholebook = vbCancel Then Exit Sub
8 | If wholebook = vbNo Then
9 | wholesheet = MsgBox("Do you want to Remove External Formulas from the whole WORKSHEET? Click no if you just want to remove from the selection. You Can't Undo This!!", vbYesNoCancel, "Apply to whole WORKSHEET?")
10 | If wholesheet = vbCancel Then Exit Sub
11 | If wholesheet = vbYes Then ActiveSheet.UsedRange.Select
12 | For Each cell In Selection
13 | If InStr(cell.Formula, "!") > 0 Then
14 | cell.Value = cell.Value
15 | replaced = replaced + 1
16 | End If
17 | Next cell
18 | Else
19 | For Each sheet In ActiveWorkbook.Worksheets
20 | For Each cell In sheet.UsedRange
21 | If InStr(cell.Formula, "!") > 0 Then
22 | cell.Value = cell.Value
23 | replaced = replaced + 1
24 | End If
25 | Next cell
26 | Next sheet
27 | End If
28 | MsgBox replaced & " formula(s) removed!"
29 |
30 | End Sub
31 |
--------------------------------------------------------------------------------
/macros/number_format.bas:
--------------------------------------------------------------------------------
1 | Sub NumberFormat()
2 | 'Purpose: Formats numbers by adding comma, removing decimals, and centering
3 | Selection.NumberFormat = "#,##0"
4 | Selection.HorizontalAlignment = xlCenter
5 | End Sub
6 |
--------------------------------------------------------------------------------
/macros/scotts_macros_all.bas:
--------------------------------------------------------------------------------
1 | 'Remove Attribute VB_Name line if copying and pasting into a VBA Module. Keep if downloading file and importing.
2 | Attribute VB_Name = "ScottsMacros"
3 |
4 | 'SCOTTS MACROS
5 | 'http://linkedin.com/in/ScottSchaen
6 |
7 | Sub FormatTopRow()
8 | 'Purpose: Freezes and formats the top row of your table to make it easier to look at and work with
9 | 'Active sheet only
10 | Dim toprow As Range
11 | 'If there's <=1 used cell in row 1 then check if the active cell is inside the table to format
12 | If Application.WorksheetFunction.CountA(Range("1:1")) > 1 Then
13 | Set toprow = Range("A1:" & Range("IV1").End(xlToLeft).Address)
14 | Else
15 | Dim tbl As Range
16 | Set tbl = Selection.CurrentRegion
17 | 'If the active cell is not inside of a table then inform user and end macro
18 | If tbl.Count = 1 Then
19 | MsgBox "Couldn't find a table to format! Click a cell in the table and run again", vbExclamation, "Couldn't find table!"
20 | Exit Sub
21 | End If
22 | Dim firstcell As Range
23 | Set firstcell = tbl.Cells(1, 1)
24 | Set toprow = Range(firstcell, firstcell.Offset(0, tbl.Columns.Count - 1))
25 | End If
26 | Cells(toprow.Row + 1, 1).Select
27 | ActiveWindow.FreezePanes = False
28 | ActiveWindow.FreezePanes = True
29 | 'Sets a grey background with white bold text
30 | With toprow.Interior
31 | .Pattern = xlSolid
32 | .PatternColorIndex = xlAutomatic
33 | .ThemeColor = xlThemeColorDark2
34 | .TintAndShade = -0.249977111117893
35 | .PatternTintAndShade = 0
36 | End With
37 | toprow.Font.Bold = True
38 | toprow.Font.Color = vbWhite
39 | End Sub
40 |
41 |
42 | Sub NumberFormat()
43 | 'Purpose: Formats numbers by adding comma, removing decimals, and centering
44 | Selection.NumberFormat = "#,##0"
45 | Selection.HorizontalAlignment = xlCenter
46 | End Sub
47 |
48 |
49 | Sub BetterAutoFilter()
50 | 'Purpose: One button that turns on autofilter (when off), clear the filter (when filtered), or shut autofilter (when on and not filtered)
51 | 'Requires more buttons and clicks otherwise
52 | On Error Resume Next
53 | If ActiveSheet.FilterMode = True Then
54 | ActiveSheet.ShowAllData
55 | Else
56 | Selection.AutoFilter
57 | End If
58 | End Sub
59 |
60 |
61 | Sub CheckForFormulas()
62 | 'Purpose: Check for formulas in current sheet
63 | On Error GoTo err
64 | Cells.SpecialCells(xlCellTypeFormulas).Select
65 | Exit Sub
66 | err:
67 | If err.Number = 1004 Then MsgBox "No Formulas Here!"
68 | End Sub
69 |
70 |
71 | Sub CheckForNAs()
72 | 'Purpose: Check for #N/As in current sheet
73 | On Error GoTo err
74 | Cells.SpecialCells(xlCellTypeFormulas, xlErrors).Select
75 | Exit Sub
76 | err:
77 | If err.Number = 1004 Then MsgBox "No Errors Here!"
78 | End Sub
79 |
80 |
81 | Sub FilterBySelection()
82 | 'Purpose: Filter for current cell in selection
83 | 'Can be used multiple times on multiple columns
84 | 'Only filters one cell so select first cell cell if multiple are selected
85 | If Selection.Count > 1 Then ActiveCell.Select
86 | 'Check for existing filter
87 | If ActiveSheet.AutoFilterMode = False Then Selection.AutoFilter
88 | 'Autofilter uses column number relative to the table
89 | filtercolumn = ActiveCell.Column - ActiveSheet.AutoFilter.Range.Column + 1
90 | 'Check for error cell
91 | If IsError(Selection.Value) Then cellvalue = Selection.Text Else cellvalue = Selection.Value
92 | 'Filter
93 | Selection.AutoFilter Field:=filtercolumn, Criteria1:="=" & cellvalue
94 | End Sub
95 |
96 |
97 | Sub FilterOutSelection()
98 | 'Purpose: Filter OUT (remove) selected cell from the selection
99 | 'Can be used multiple times multiple columns
100 | 'Only filters one cell so select first cell cell if multiple are selected
101 | If Selection.Count > 1 Then ActiveCell.Select
102 | 'Check for existing filter
103 | If ActiveSheet.AutoFilterMode = False Then Selection.AutoFilter
104 | 'Autofilter uses column number relative to the table
105 | filtercolumn = ActiveCell.Column - ActiveSheet.AutoFilter.Range.Column + 1
106 | 'Check for error cell
107 | If IsError(Selection.Value) Then cellvalue = Selection.Text Else cellvalue = Selection.Value
108 | 'Filter
109 | Selection.AutoFilter Field:=filtercolumn, Criteria1:="<>" & cellvalue, Operator:=xlAnd
110 | End Sub
111 |
112 |
113 | Sub TopLeftActiveCell()
114 | 'Purpose: Sets active cell to top left ($A$1) for all sheets
115 | Dim currsheet As Worksheet
116 | Dim sheet As Worksheet
117 | Set currsheet = ActiveSheet
118 | 'Change A1 to suit your preference
119 | Const TopLeft As String = "A1"
120 | 'Loop through all the sheets in the workbook
121 | For Each sheet In Worksheets
122 | 'Only does this for visible worksheets
123 | If sheet.Visible = xlSheetVisible Then Application.GoTo sheet.Range(TopLeft), Scroll:=True
124 | Next sheet
125 | currsheet.Activate
126 | End Sub
127 |
128 |
129 | Sub KillExternalFormulas()
130 | 'Purpose: Replaces external formulas that link to other workbooks with their values
131 | 'Only applies to cells in selection
132 | Dim replaced As Integer
133 | replaced = 0
134 | wholebook = MsgBox("Do you want to Remove External Formulas from the whole WORKBOOK? Click no for active sheet or selection. You Can't Undo This!!", vbYesNoCancel + vbInformation, "Apply to whole WORKBOOK?")
135 | If wholebook = vbCancel Then Exit Sub
136 | If wholebook = vbNo Then
137 | wholesheet = MsgBox("Do you want to Remove External Formulas from the whole WORKSHEET? Click no if you just want to remove from the selection. You Can't Undo This!!", vbYesNoCancel, "Apply to whole WORKSHEET?")
138 | If wholesheet = vbCancel Then Exit Sub
139 | If wholesheet = vbYes Then ActiveSheet.UsedRange.Select
140 | For Each cell In Selection
141 | If InStr(cell.Formula, "!") > 0 Then
142 | cell.Value = cell.Value
143 | replaced = replaced + 1
144 | End If
145 | Next cell
146 | Else
147 | For Each sheet In ActiveWorkbook.Worksheets
148 | For Each cell In sheet.UsedRange
149 | If InStr(cell.Formula, "!") > 0 Then
150 | cell.Value = cell.Value
151 | replaced = replaced + 1
152 | End If
153 | Next cell
154 | Next sheet
155 | End If
156 | MsgBox replaced & " formula(s) removed!"
157 |
158 | End Sub
159 |
160 |
161 | Sub SelectUnique()
162 | 'Purpose: Select only unique values in selection. Effectively removes duplicates from selection.
163 | 'Selection does not need to be a single range, but it does need to be on the same sheet.
164 | If Selection.Count > 5000 Then
165 | response = MsgBox("This could take a while", vbOKCancel + vbInformation)
166 | If response = vbCancel Then Exit Sub
167 | End If
168 | ReDim vals(Selection.Count)
169 | Dim uniques As Range
170 | 'Cycle through all values in selection
171 | For Each cell In Selection
172 | 'Skip blank cells and errored cells
173 | If Not IsError(cell) And Not IsEmpty(cell) Then
174 | 'Set first value
175 | If uniques Is Nothing Then
176 | Set uniques = cell
177 | vals(1) = cell.Value
178 | uniq_counter = 2
179 | End If
180 | 'Check each cell against previously set unique values
181 | For checker = 1 To uniq_counter - 1
182 | If vals(checker) = cell.Value Then Exit For
183 | If checker = uniq_counter - 1 Then
184 | Set uniques = Union(uniques, cell)
185 | vals(uniq_counter) = cell.Value
186 | uniq_counter = uniq_counter + 1
187 | End If
188 | Next checker
189 | End If
190 | Next cell
191 | 'Select unique range if it exists
192 | If Not uniques Is Nothing Then uniques.Select
193 | End Sub
194 |
195 |
196 | Sub CommaSeparateSelection()
197 | 'Purpose: Comma separates all cells in selection and outputs them to an unused adjacent cell
198 | 'Current sheet only
199 | Dim outputcell As Range
200 | Set outputcell = Range("IV1").End(xlToLeft).Offset(0, 1)
201 | 'Wrap comma separated values in quotes yes/no
202 | apos = MsgBox("Add apostrophes?", vbYesNo, "Add apostrophes and wrap selections in quotes?")
203 | If apos = vbYes Then apos = True Else apos = False
204 | For Each cell In Selection
205 | If cell.Value <> "" Then
206 | If apos = False Then outputcell.Value = outputcell.Value & cell.Value & ", "
207 | If apos = True Then outputcell.Value = outputcell.Value & "'" & cell.Value & "', "
208 | End If
209 | Next cell
210 | 'Removes trailing comma
211 | outputcell.Value = Left(outputcell.Value, Len(outputcell.Value) - 2)
212 | End Sub
213 |
--------------------------------------------------------------------------------
/macros/select_uniques.bas:
--------------------------------------------------------------------------------
1 | Sub SelectUnique()
2 | 'Purpose: Select only unique values in selection. Effectively removes duplicates from selection.
3 | 'Selection does not need to be a single range, but it does need to be on the same sheet.
4 | If Selection.Count > 5000 Then
5 | response = MsgBox("This could take a while", vbOKCancel + vbInformation)
6 | If response = vbCancel Then Exit Sub
7 | End If
8 | ReDim vals(Selection.Count)
9 | Dim uniques As Range
10 | 'Cycle through all values in selection
11 | For Each cell In Selection
12 | 'Skip blank cells and errored cells
13 | If Not IsError(cell) And Not IsEmpty(cell) Then
14 | 'Set first value
15 | If uniques Is Nothing Then
16 | Set uniques = cell
17 | vals(1) = cell.Value
18 | uniq_counter = 2
19 | End If
20 | 'Check each cell against previously set unique values
21 | For checker = 1 To uniq_counter - 1
22 | If vals(checker) = cell.Value Then Exit For
23 | If checker = uniq_counter - 1 Then
24 | Set uniques = Union(uniques, cell)
25 | vals(uniq_counter) = cell.Value
26 | uniq_counter = uniq_counter + 1
27 | End If
28 | Next checker
29 | End If
30 | Next cell
31 | 'Select unique range if it exists
32 | If Not uniques Is Nothing Then uniques.Select
33 | End Sub
34 |
--------------------------------------------------------------------------------
/macros/top_left_active_cell.bas:
--------------------------------------------------------------------------------
1 | Sub TopLeftActiveCell()
2 | 'Purpose: Sets active cell to top left ($A$1) for all sheets
3 | Dim currsheet As Worksheet
4 | Dim sheet As Worksheet
5 | Set currsheet = ActiveSheet
6 | 'Change A1 to suit your preference
7 | Const TopLeft As String = "A1"
8 | 'Loop through all the sheets in the workbook
9 | For Each sheet In Worksheets
10 | 'Only does this for visible worksheets
11 | If sheet.Visible = xlSheetVisible Then Application.GoTo sheet.Range(TopLeft), Scroll:=True
12 | Next sheet
13 | currsheet.Activate
14 | End Sub
15 |
--------------------------------------------------------------------------------