VBA - Misc useful Excel MACROs

These are a collection of tools I use to help me with redundant tasks:

Sub ToolAppendWorksheets()
    'Define some vars
    Dim wb As Workbook, wb2 As Workbook
    Dim WS As Worksheet
    Dim vFile As Variant
    
    'Set source workbook/worksheet
    Set wb = ActiveWorkbook
    Set WS = ActiveSheet
    
    'Open the target workbook
    vFile = Application.GetOpenFilename("Excel-files,*", _
        1, "Select a file to append worksheets from", , False)
    'if the user didn't select a file, exit sub
    If TypeName(vFile) = "Boolean" Then Exit Sub
    Workbooks.Open vFile
    'Set targetworkbook
    Set wb2 = ActiveWorkbook
    
    For Each sh In wb2.Worksheets
        sh.Copy After:=wb.Sheets(wb.Sheets.Count)
    Next sh
    
    wb2.Close SaveChanges:=False
    
End Sub
Sub ToolRemoveDuplicates()
    'A macro to delete all rows that have a duplicate entry in a certain column
    'Easy user defined vars
    DupCol = Int(InputBox("Which column are we comparing for duplicate entries?"))
    CompareChars = 50
    StartingRow = Int(InputBox("Starting at which row?"))
    
    'Internal code
    lastrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
    
    For rwIndex = StartingRow To lastrow
            CurLastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
            For delIndex = CurLastRow To rwIndex + 1 Step -1
                If Left(Cells(rwIndex, DupCol), CompareChars) = Left(Cells(delIndex, DupCol), CompareChars) Then
                    Rows(delIndex).Delete
                End If
            Next delIndex
    Next rwIndex
End Sub
Sub ToolInsertXRows()
    RowsToInsert = InputBox("How many rows would you like to insert?")
    InsertPoint = InputBox("Which row would you like to insert them at?")
    
    For Point = 1 To RowsToInsert
        Cells(InsertPoint, 1).Offset(1).EntireRow.Insert
    Next Point
End Sub
Sub ToolJoinAndMerge()
    Dim outputText As String
    delim = " "
    On Error Resume Next
    For Each cell In Selection
    outputText = outputText & cell.value & delim
    Next cell
    'Removes the Trailing Delim
    If Right$(outputText, 1) = delim Then outputText = Left$(outputText, Len(outputText) - 1)
    With Selection
    .Clear
    .Cells(1).value = outputText
    .Merge
    .HorizontalAlignment = xlGeneral
    .VerticalAlignment = xlCenter
    .WrapText = True
    End With
    Selection.ClearFormats
End Sub
Sub ToolDeleteBlankRows()
    
    'Deletes the entire row within the selection if the ENTIRE row contains no data.
    
    'We use Long in case they have over 32,767 rows selected.
    
    Dim i As Long
    
        'We turn off calculation and screenupdating to speed up the macro.
    
        With Application
    
            .Calculation = xlCalculationManual
    
            .ScreenUpdating = False
    
        'We work backwards because we are deleting rows.
    
        For i = Selection.Rows.Count To 1 Step -1
    
            If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
    
                Selection.Rows(i).EntireRow.Delete
    
            End If
    
        Next i
    
            .Calculation = xlCalculationAutomatic
    
            .ScreenUpdating = True
    
        End With
    
End Sub