Automatically adds a sequential list of numbers downward from the active cell. An input box asks how many numbers to insert.

Sub AddSerialNumbers()
    Dim i As Integer
    On Error GoTo Last
    i = InputBox("Enter Value", "Enter Serial Numbers")
    For i = 1 To i
        ActiveCell.Value = i
        ActiveCell.Offset(1, 0).Activate
    Next i
Last: Exit Sub
End Sub

Inserts a specified number of columns to the right of the active cell in one step — no need to repeat the insert command manually.

Sub InsertMultipleColumns()
    Dim i As Integer, j As Integer
    ActiveCell.EntireColumn.Select
    On Error GoTo Last
    i = InputBox("Enter number of columns to insert", "Insert Columns")
    For j = 1 To i
        Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromRightorAbove
    Next j
Last: Exit Sub
End Sub

Inserts multiple rows at once starting from the active cell. Enter the count in the input box when prompted.

Sub InsertMultipleRows()
    Dim i As Integer, j As Integer
    ActiveCell.EntireRow.Select
    On Error GoTo Last
    i = InputBox("Enter number of rows to insert", "Insert Rows")
    For j = 1 To i
        Selection.Insert Shift:=xlToDown, CopyOrigin:=xlFormatFromRightorAbove
    Next j
Last: Exit Sub
End Sub

Instantly auto-fits the width of every column in the active worksheet to match its content — no manual dragging needed.

Sub AutoFitColumns()
    Cells.Select
    Cells.EntireColumn.AutoFit
End Sub

Instantly auto-fits the height of every row in the active worksheet to match its content.

Sub AutoFitRows()
    Cells.Select
    Cells.EntireRow.AutoFit
End Sub

Removes text wrap from every cell in the active worksheet, then auto-fits all rows and columns so your layout snaps back into shape.

Sub RemoveTextWrap()
    Cells.WrapText = False
    Cells.EntireRow.AutoFit
    Cells.EntireColumn.AutoFit
End Sub

Unmerges all merged cells in the current selection. Add to your Quick Access Toolbar for one-click access.

Sub UnmergeCells()
    Selection.UnMerge
End Sub

Makes all hidden rows and columns in the active worksheet visible again — no need to unhide them one by one.

Sub UnhideRowsColumns()
    Columns.EntireColumn.Hidden = False
    Rows.EntireRow.Hidden = False
End Sub

Copies the selected range and pastes it as a static picture into the same sheet. Useful for locking down a table's appearance for reporting.

Sub PasteAsPicture()
    Application.CutCopyMode = False
    Selection.Copy
    ActiveSheet.Pictures.Paste.Select
End Sub

Pastes the selected range as a linked image — the picture updates automatically when the source data changes. Great for dashboards.

Sub LinkedPicture()
    Selection.Copy
    ActiveSheet.Pictures.Paste(Link:=True).Select
End Sub

Checks each cell in the selection and highlights any duplicate values in yellow. Select your range before running.

Sub HighlightDuplicateValues()
    Dim myRange As Range, myCell As Range
    Set myRange = Selection
    For Each myCell In myRange
        If WorksheetFunction.CountIf(myRange, myCell.Value) > 1 Then
            myCell.Interior.ColorIndex = 36
        End If
    Next myCell
End Sub

Double-click any cell to select its entire row and column — great for navigating large data tables. This goes in the sheet's own code window, not a module.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim strRange As String
    strRange = Target.Cells.Address & "," & _
               Target.Cells.EntireColumn.Address & "," & _
               Target.Cells.EntireRow.Address
    Range(strRange).Select
End Sub

Select a range and run this macro to highlight the top 10 values in green using a conditional formatting rule.

Sub HighlightTopTen()
    Selection.FormatConditions.AddTop10
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1)
        .TopBottom = xlTop10Top
        .Rank = 10
        .Percent = False
    End With
    With Selection.FormatConditions(1).Interior
        .Color = 13561798
    End With
    Selection.FormatConditions(1).StopIfTrue = False
End Sub

Highlights all named ranges in the workbook so you can see exactly which cells have names assigned to them.

Sub HighlightNamedRanges()
    Dim RangeName As Name, HighlightRange As Range
    On Error Resume Next
    For Each RangeName In ActiveWorkbook.Names
        Set HighlightRange = RangeName.RefersToRange
        HighlightRange.Interior.ColorIndex = 36
    Next RangeName
End Sub

Prompts for a threshold and highlights all cells in the selection that are greater than it in green.

Sub HighlightGreaterThanValues()
    Dim i As Integer
    i = InputBox("Enter Greater Than Value", "Enter Value")
    Selection.FormatConditions.Delete
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, Formula1:=i
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1)
        .Font.Color = RGB(0, 0, 0)
        .Interior.Color = RGB(31, 218, 154)
    End With
End Sub

Prompts for a threshold and highlights all cells in the selection that are below it in red.

Sub HighlightLowerThanValues()
    Dim i As Integer
    i = InputBox("Enter Lower Than Value", "Enter Value")
    Selection.FormatConditions.Delete
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, Formula1:=i
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1)
        .Font.Color = RGB(0, 0, 0)
        .Interior.Color = RGB(217, 83, 79)
    End With
End Sub

Scans every cell in the selection and changes the font colour of any negative number to red.

Sub HighlightNegativeNumbers()
    Dim Rng As Range
    For Each Rng In Selection
        If WorksheetFunction.IsNumber(Rng) Then
            If Rng.Value < 0 Then
                Rng.Font.Color = -16776961
            End If
        End If
    Next
End Sub

Searches for a specific text string and highlights matching characters in red. Select two columns before running: column A = source text, column B = the text to find.

Sub HighlightSpecificText()
    Dim myStr As String, myRg As Range
    Dim I As Long, J As Long
    On Error Resume Next
    Set myRg = Application.InputBox("Select a two-column range:", "Selection Required", , , , , , 8)
    If myRg Is Nothing Then Exit Sub
    If myRg.Columns.Count <> 2 Then
        MsgBox "Please select exactly two columns." : Exit Sub
    End If
    For I = 0 To myRg.Rows.Count - 1
        myStr = myRg.Range("B1").Offset(I, 0).Value
        With myRg.Range("A1").Offset(I, 0)
            .Font.ColorIndex = 1
            For J = 1 To Len(.Text)
                If Mid(.Text, J, Len(myStr)) = myStr Then
                    .Characters(J, Len(myStr)).Font.ColorIndex = 3
                End If
            Next J
        End With
    Next I
End Sub

Applies the built-in "Note" style to all cells containing comments in the current selection, making them easy to spot at a glance.

Sub HighlightCommentCells()
    Selection.SpecialCells(xlCellTypeComments).Select
    Selection.Style = "Note"
End Sub

Highlights every other row in the selection to create a striped/banded table effect that makes data easier to read.

Sub HighlightAlternateRows()
    Dim rng As Range
    For Each rng In Selection.Rows
        If rng.Row Mod 2 = 1 Then
            rng.Style = "20% - Accent1"
        End If
    Next rng
End Sub

Scans the entire used range and applies the "Bad" style to any cell containing a spelling error.

Sub HighlightMisspelledCells()
    Dim rng As Range
    For Each rng In ActiveSheet.UsedRange
        If Not Application.CheckSpelling(Word:=rng.Text) Then
            rng.Style = "Bad"
        End If
    Next rng
End Sub

Scans the entire worksheet, highlights all error cells in red, and shows a count of how many were found.

Sub HighlightErrors()
    Dim rng As Range, i As Integer
    For Each rng In ActiveSheet.UsedRange
        If WorksheetFunction.IsError(rng) Then
            i = i + 1
            rng.Style = "Bad"
        End If
    Next rng
    MsgBox "There are total " & i & " error(s) in this worksheet."
End Sub

Prompts for a value, then highlights every matching cell in the used range and shows a count of matches found.

Sub HighlightSpecificValues()
    Dim rng As Range, i As Integer, c As Variant
    c = InputBox("Enter Value To Highlight")
    For Each rng In ActiveSheet.UsedRange
        If rng = c Then
            rng.Style = "Note"
            i = i + 1
        End If
    Next rng
    MsgBox "There are total " & i & " " & c & " in this worksheet."
End Sub

Finds cells that look blank but contain a single space character — a common data quality issue — and highlights them.

Sub HighlightBlankWithSpace()
    Dim rng As Range
    For Each rng In ActiveSheet.UsedRange
        If rng.Value = " " Then
            rng.Style = "Note"
        End If
    Next rng
End Sub

Finds the highest value in the selected range and highlights it in green.

Sub HighlightMaxValue()
    Dim rng As Range
    For Each rng In Selection
        If rng = WorksheetFunction.Max(Selection) Then
            rng.Style = "Good"
        End If
    Next rng
End Sub

Finds the lowest value in the selected range and highlights it in green.

Sub HighlightMinValue()
    Dim rng As Range
    For Each rng In Selection
        If rng = WorksheetFunction.Min(Selection) Then
            rng.Style = "Good"
        End If
    Next rng
End Sub

Highlights all cells in the selection that contain a unique (non-duplicate) value using a conditional formatting rule.

Sub HighlightUniqueValues()
    Dim rng As Range
    Set rng = Selection
    rng.FormatConditions.Delete
    Dim uv As UniqueValues
    Set uv = rng.FormatConditions.AddUniqueValues
    uv.DupeUnique = xlUnique
    uv.Interior.Color = vbGreen
End Sub

Highlights cells where the value differs from the corresponding cell in the reference column — ideal for comparing two data sets side by side.

Sub ColumnDifference()
    Selection.ColumnDifferences(ActiveCell).Select
    Selection.Style = "Bad"
End Sub

Highlights cells where the value differs from the corresponding cell in the reference row.

Sub RowDifference()
    Selection.RowDifferences(ActiveCell).Select
    Selection.Style = "Bad"
End Sub

Protects only formula cells, leaving all other cells editable. Useful for sharing workbooks where you want to prevent accidental formula deletion.

Sub LockCellsWithFormulas()
    With ActiveSheet
        .Unprotect
        .Cells.Locked = False
        .Cells.SpecialCells(xlCellTypeFormulas).Locked = True
        .Protect AllowDeletingRows:=True
    End With
End Sub

Scans the entire used range and highlights every cell containing a formula in yellow — useful for quickly auditing a sheet.

Sub HighlightFormulas()
    Dim cell As Range
    For Each cell In ActiveSheet.UsedRange
        If cell.HasFormula Then
            cell.Interior.Color = RGB(255, 255, 0)
        End If
    Next cell
End Sub

Converts all text in the selected cells to UPPER CASE. Non-text cells are left unchanged.

Sub ConvertToUpperCase()
    Dim Rng As Range
    For Each Rng In Selection
        If Application.WorksheetFunction.IsText(Rng) Then
            Rng.Value = UCase(Rng)
        End If
    Next
End Sub

Converts all text in the selected cells to lower case. Non-text cells are skipped.

Sub ConvertToLowerCase()
    Dim Rng As Range
    For Each Rng In Selection
        If Application.WorksheetFunction.IsText(Rng) Then
            Rng.Value = LCase(Rng)
        End If
    Next
End Sub

Capitalises The First Letter Of Every Word. Useful for cleaning name lists or titles.

Sub ConvertToProperCase()
    Dim Rng As Range
    For Each Rng In Selection
        If WorksheetFunction.IsText(Rng) Then
            Rng.Value = WorksheetFunction.Proper(Rng.Value)
        End If
    Next
End Sub

Capitalises only the first letter of the text in each cell. Perfect for sentence-style labels and descriptions.

Sub ConvertToSentenceCase()
    Dim Rng As Range
    For Each Rng In Selection
        If WorksheetFunction.IsText(Rng) Then
            Rng.Value = UCase(Left(Rng, 1)) & LCase(Right(Rng, Len(Rng) - 1))
        End If
    Next Rng
End Sub

Trims leading, trailing, and extra internal spaces from every text cell in the selection — equivalent to applying Excel's TRIM function directly to the values.

Sub RemoveSpaces()
    Dim myCell As Range
    Select Case MsgBox("You Can't Undo This. Save Workbook First?", vbYesNoCancel, "Alert")
        Case Is = vbYes:    ThisWorkbook.Save
        Case Is = vbCancel: Exit Sub
    End Select
    For Each myCell In Selection
        If Not IsEmpty(myCell) Then myCell = Trim(myCell)
    Next myCell
End Sub

A custom worksheet function that removes a specified number of characters from the start of a text string. Use it in a cell like a regular formula.

Public Function RemoveFirstC(rng As String, cnt As Long)
    RemoveFirstC = Right(rng, Len(rng) - cnt)
End Function

Prompts you to enter a character and removes every instance of it from all cells in the selection.

Sub RemoveChar()
    Dim Rng As Range, rc As String
    rc = InputBox("Character(s) to Remove", "Enter Value")
    For Each Rng In Selection
        Selection.Replace What:=rc, Replacement:=""
    Next
End Sub

A custom worksheet function that reverses the characters in a text string. Use it directly in cells like any Excel formula.

Public Function Rvrse(ByVal cell As Range) As String
    Rvrse = VBA.StrReverse(cell.Value)
End Function

Counts every word across all cells in the active worksheet and displays the total in a message box.

Sub WordCountWorksheet()
    Dim WordCnt As Long, rng As Range
    Dim S As String, N As Long
    For Each rng In ActiveSheet.UsedRange.Cells
        S = Application.WorksheetFunction.Trim(rng.Text)
        N = 0
        If S <> vbNullString Then
            N = Len(S) - Len(Replace(S, " ", "")) + 1
        End If
        WordCnt = WordCnt + N
    Next rng
    MsgBox "There are total " & Format(WordCnt, "#,##0") & " words in the active worksheet"
End Sub

A custom worksheet function that converts any whole number to its written English equivalent. Use it in cells like a regular Excel formula: =NumberToWords(A1).

Function NumberToWords(ByVal MyNumber As Long) As String
    Dim Units(1 To 9) As String, Teens(10 To 19) As String
    Dim Tens(2 To 9) As String, Result As String
    Units(1)="One":Units(2)="Two":Units(3)="Three":Units(4)="Four"
    Units(5)="Five":Units(6)="Six":Units(7)="Seven"
    Units(8)="Eight":Units(9)="Nine"
    Teens(10)="Ten":Teens(11)="Eleven":Teens(12)="Twelve"
    Teens(13)="Thirteen":Teens(14)="Fourteen":Teens(15)="Fifteen"
    Teens(16)="Sixteen":Teens(17)="Seventeen"
    Teens(18)="Eighteen":Teens(19)="Nineteen"
    Tens(2)="Twenty":Tens(3)="Thirty":Tens(4)="Forty"
    Tens(5)="Fifty":Tens(6)="Sixty":Tens(7)="Seventy"
    Tens(8)="Eighty":Tens(9)="Ninety"
    If MyNumber = 0 Then NumberToWords = "Zero": Exit Function
    If MyNumber < 0 Then Result = "Negative ": MyNumber = Abs(MyNumber)
    If MyNumber >= 1000 Then
        Result = Result & Units(Int(MyNumber/1000)) & " Thousand "
        MyNumber = MyNumber Mod 1000
    End If
    If MyNumber >= 100 Then
        Result = Result & Units(Int(MyNumber/100)) & " Hundred "
        MyNumber = MyNumber Mod 100
    End If
    If MyNumber >= 20 Then
        Result = Result & Tens(Int(MyNumber/10)) & " "
        MyNumber = MyNumber Mod 10
    ElseIf MyNumber >= 10 Then
        Result = Result & Teens(MyNumber): MyNumber = 0
    End If
    If MyNumber > 0 Then Result = Result & Units(MyNumber)
    NumberToWords = Trim(Result)
End Function

Multiplies every number in the selection by a value you specify. The original code used addition (+) instead of multiplication (*) — now fixed. Also upgraded to Double so decimal multipliers like 1.5 work correctly.

Sub MultiplyAllValues()
    Dim rng As Range, i As Double
    i = InputBox("Enter the number to multiply by", "Multiply Values")
    If i = 0 Then Exit Sub
    For Each rng In Selection
        If WorksheetFunction.IsNumber(rng) Then
            rng.Value = rng.Value * i
        End If
    Next rng
End Sub

Adds the same number to every cell in the selection. Enter a negative value (e.g. -10) to subtract from all values instead. Useful for bulk adjustments like adding a fixed fee or offset across a list of prices.

Sub AddToAllValues()
    Dim rng As Range, i As Double
    i = InputBox("Enter the number to add", "Add to Values")
    For Each rng In Selection
        If WorksheetFunction.IsNumber(rng) Then
            rng.Value = rng.Value + i
        End If
    Next rng
End Sub

Replaces every number in the selection with its square root, in-place — no helper column needed. Useful for bulk statistical transformations on a dataset.

Sub GetSquareRoot()
    Dim rng As Range
    For Each rng In Selection
        If WorksheetFunction.IsNumber(rng) Then
            rng.Value = Sqr(rng)
        End If
    Next rng
End Sub

Replaces every number in the selection with its cube root. Uses the exponent ^ (1/3) since VBA has no built-in cube root function.

Sub GetCubeRoot()
    Dim rng As Range
    For Each rng In Selection
        If WorksheetFunction.IsNumber(rng) Then
            rng.Value = rng ^ (1 / 3)
        End If
    Next rng
End Sub

Strips the decimal portion from every number in the selection, rounding down to the nearest whole number using VBA's Int() function.

Sub RemoveDecimals()
    Dim rng As Range
    For Each rng In Selection
        rng.Value = Int(rng)
        rng.NumberFormat = "0"
    Next rng
End Sub

Converts all negative numbers in the selection to their absolute (positive) values using VBA's Abs() function. Non-numeric cells are skipped.

Sub RemoveNegativeSign()
    Dim rng As Range
    For Each rng In Selection
        If WorksheetFunction.IsNumber(rng) Then
            rng.Value = Abs(rng)
        End If
    Next rng
End Sub

Removes leading apostrophes from numbers stored as text — a common problem when importing data from other systems. The apostrophe forces Excel to treat the number as text; this macro converts them back to true numeric values.

Sub RemoveApostrophes()
    Selection.Value = Selection.Value
End Sub

Finds every empty cell (including cells with a single space) in the selection and fills it with 0. Prevents #DIV/0! and other formula errors that occur when calculations reference blank cells.

Sub ReplaceBlankWithZero()
    Dim rng As Range
    For Each rng In Selection
        If rng = "" Or rng = " " Then
            rng.Value = "0"
        End If
    Next rng
End Sub

Converts Roman numeral text (e.g. XIV, XLII) in selected cells to their Arabic number equivalents using Excel's built-in ARABIC worksheet function.

Sub ConvertRomanToArabic()
    Dim rng As Range
    For Each rng In Selection
        If Not WorksheetFunction.IsNonText(rng) Then
            rng.Value = WorksheetFunction.Arabic(rng)
        End If
    Next rng
End Sub

Appends a degree symbol (°) to every number in the selection. Useful for temperature data, angles, or any measurement that requires the degree symbol but where you want to keep the values editable.

Sub AddDegreeSymbol()
    Dim rng As Range
    For Each rng In Selection
        If IsNumeric(rng.Value) Then
            rng.Value = rng.Value & "°"
        End If
    Next
End Sub