what do YOU have on your toolbar

RET79

Well-known Member
Joined
Mar 19, 2002
Messages
526
Hi.

A light hearted posting now.....

What custom features on your toolbar etc. have you got on your excel that you could not live without? What little macros do you have that you need all the time to make your life easier?

RET79
 
Code:
Sub DisableEvents()
Application.EnableEvents = False
End Sub

Code:
Sub EnableEvents()
Application.EnableEvents = True
End Sub

Code:
Option Explicit
Dim LastCell As Range
Dim lcAddress$, rw&, col%, alphaCol$
Dim Msg$, M%
Dim R As Variant, C As Variant, chk%

Sub ResetLastCell()

If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
Set LastCell = _
    Cells(Range([A1], ActiveSheet.UsedRange).Rows.Count, _
    Range([A1], ActiveSheet.UsedRange).Columns.Count)
lcAddress = LastCell.Address(False, False)
rw = LastCell.Row
col = LastCell.Column
alphaCol = Left(lcAddress, (col < 27) + 2)
If lcAddress = "A1" Then GoTo x
If Application.CountA(Columns(col)) = 0 Or _
    Application.CountA(Rows(rw)) = 0 Then
    Msg = "The last cell in " & ActiveSheet.Name & _
        " is cell " & lcAddress & _
        "." & vbCrLf & vbCrLf & "Row " & rw & _
        " , Column " & col & " ( " & alphaCol & " )" & vbCrLf & vbCrLf & _
        "Do you wish to reset this to another cell?"
    M = MsgBox(Msg, vbYesNoCancel, "Reset Last Cell")
Else
x:
    MsgBox "The last cell in " & ActiveSheet.Name & _
    " has been reset to cell " & lcAddress & _
    "." & vbCrLf & vbCrLf & "Row " & rw & _
    " , Column " & col & " ( " & alphaCol & " )"
    Exit Sub
End If

If M = vbCancel Or M = vbNo Then Exit Sub
If M = vbYes Then
    On Error Resume Next
    Application.DisplayAlerts = False
    Set R = Application.InputBox("Select the required last row", Type:=8)
    Set C = Application.InputBox("Select the required last column", Type:=8)
    Application.DisplayAlerts = True
    If R Is Nothing Then If C Is Nothing Then GoTo e
    If Not R Is Nothing Then If C Is Nothing Then GoTo delR
    If R Is Nothing Then If Not C Is Nothing Then GoTo delC
    If Not R Is Nothing Then If Not C Is Nothing Then GoTo delRC
End If

delR:
    On Error GoTo 0
    chk = MsgBox("All rows after row " & R.Row & " will be permanently deleted." _
    & vbCrLf & vbCrLf & "Are you sure you want to continue?", vbYesNoCancel, "ALERT !")
    If chk = vbCancel Or chk = vbNo Then Exit Sub
    Rows(R.Row + 1 & ":65536").Delete
    Call SetLastCell
    GoTo e
delC:
    On Error GoTo 0
    chk = MsgBox("All columns after column " & C.Column & " will be permanently deleted." _
    & vbCrLf & vbCrLf & "Are you sure you want to continue?", vbYesNoCancel, "ALERT !")
    If chk = vbCancel Or chk = vbNo Then Exit Sub
    MsgBox C.Column + 1
    Range(Columns(C.Column + 1), Columns(256)).Delete
    Call SetLastCell
    GoTo e
delRC:
    On Error GoTo 0
    chk = MsgBox("All rows after row " & R.Row & " and all columns after column " & C.Column & _
    " will be permanently deleted." & vbCrLf & vbCrLf & _
    "Are you sure you want to continue?", vbYesNoCancel, "ALERT !")
    If chk = vbCancel Or chk = vbNo Then Exit Sub
    Rows(R.Row + 1 & ":65536").Delete
    Range(Columns(C.Column + 1), Columns(256)).Delete
    Call SetLastCell
    GoTo e
e:
On Error GoTo 0
End Sub

Sub SetLastCell()
Dim LastCell As Range
Set LastCell = _
Cells(Range([A1], ActiveSheet.UsedRange).Rows.Count, _
    Range([A1], ActiveSheet.UsedRange).Columns.Count)
lcAddress = LastCell.Address(False, False)
rw = LastCell.Row
col = LastCell.Column
alphaCol = Left(lcAddress, (col < 27) + 2)
MsgBox "The last cell in " & ActiveSheet.Name & _
    " has been reset to cell " & lcAddress & _
    "." & vbCrLf & vbCrLf & "Row " & rw & _
    " , Column " & col & " ( " & alphaCol & " )"
End Sub
 
Upvote 0

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).

Forum statistics

Threads
1,213,561
Messages
6,114,317
Members
448,564
Latest member
ED38

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top