Main Page 
 MS Excel
 Stamps 
 St. Louis 
 
 Recipes 
 

Assorted Code Cuts

I have been adding a lot of whole programs so I thought this was a good time to drop back to basics and show how I do some little stuff. This is a start, more to come shortly.

UnProtect - Do Processing - Re-Protect

So you have a password on some cells. You need to sort or something in your code but your users should not be able to move things around. Somewhere near the top, you what to define the password like

Dim pW2 as String
    pW2="iDiOt"

	ActiveSheet.Unprotect password:=pW2	'Remove protection
		{some more code goes here}
	ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios _
        :=True, password:=pW2			'Re-protect

Save without Asking Permission

I am frequently asked about Excel stopping to ask permission to save, delete, etc.. 

	Application.DisplayAlerts = False	'Turn off before saving
  	ActiveWorkbook.SaveAs filename:="C:\DATA\myfile.XLS", _
            FileFormat:=xlNormal
	Application.DisplayAlerts = True  	'Turn on so important messages display

Open a Dialog to Request a File

Recently had a case where a vital file would be on a network and it might be a different path for everyone. This example opens the dialog, asking for the file by name, and lets the user point to the directory where it is located.   (added 01/20/2001)

    Application.Dialogs(xlDialogOpen).Show "Masterre.XLS"  'Get the Master
    On Error GoTo ErHandles     'Handles MASTER not open

Message Box and Save

Pulled out all the stops on this last project. Wanted to give the user the option of saving at the end of the run with a Suggested name..   (added 01/20/2001)

SaveBox = MsgBox("Would you like to save this file now? If you answer OK," _
	"a name will be suggested.", _
         vbOKCancel, "Save File...")	'Ask Question, choice of controls, Title
    If SaveBox = vbOK Then
        Application.Dialogs(xlDialogSaveAs).Show SuggName	'Show name from other 
    End If

Here is where I suggested a name

SuggName = "1120 Long " & Left(Sheets("Practical Stuff").Range("D4"), 5) _
	& Application.Text(Now(), "mmdd") & ".XLS"	'Build a suggested file name

Generate a Formula from VBA

Sometimes you want to generate a function to be included on the page. You need the range of cells expressed as an address. The example below comes out to something like =AVERAGE($D$6:$D$40).   (added 01/20/2001)

        Cells(Stone + 1, 7) = "=AVERAGE(" & Range(Cells(6, 7), _
	 Cells(Stone - 1, 7)).Address & ")"

Run Multiple Routines

In the big macro I am pulling all these little routines from, I have sections that are ‘traffic cops’ and run all the little re-usable routines. See how the following has so many lines the Run Macro.

Sub BasicReport()
    GetText         'Run macro
    ThePath = "C:\Data\Stuff\"
    ComName = ThePath & RptName & ".XLS"
    ActiveWorkbook.SaveAs filename:=ComName, _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    LastRow = Application.CountA(ActiveSheet.Range("A:A"))
    MailCol = 1         'If Mailing
    ListType = "ABC Phone List"
    SortRoutine     'Run macro
    For Q = 1 To LastRow
        If Left(Cells(Q, 1), 2) = "MC" Then     'Convert MC in anticipation of Mixed Case
            Cells(Q, 1).Value = "MC " & Right(Cells(Q, 1), _
	    Len(Cells(Q, 1)) - 2)
        End If
    Next
    ContractorFx    'Contractor & Phone
    CharOpts           'Run macro
    FixMonths           'Run macro
    ColorRows           'Run macro
    RemoveCols          'Run macro
    SetPrint            'Run macro
    MailOpts        'Determine whether to mail or not
End Sub

 

My Favorite Instructions

I have a spreadsheet I keep constantly available where I have entered my most commonly used instructions, you may recognize some of these. I liked it so much that I printed it (along with an Excel color chart) and it is at home and office.

Code Explanation 
CurrActiveSheet = ActiveWorkbook.Name            
Get the name of the active workbook 
Selection.NumberFormat = "### ###-####"
  
LastRow = Application.CountA(ActiveSheet.Range("M:M"))
 Get row number of last contiguous cell in column 
Windows("Phone List.xls").Activate
 Select a workbook other than the one you are working in 
ActiveSheet.Range(Cells(2, 9), Cells(BotRange, 11)).Select
 Select a range of cells 
BottomRw = ActiveCell.SpecialCells(xlLastCell).Row
 Get the row number of the last used cell 
Pather = ThisWorkbook.Path & "\"
   
Application.Union(Cells(i, 1), Cells(i, 10), Cells(i, 4)).Select
Use to select a group of non-adjacent cells 
Selection.Copy
 Copy the cells 
ActiveSheet.Paste
 Paste them in the location on the current sheet 
Application.ScreenUpdating = True
 Turn screen updating back on a conclusion; FALSE prevents that annoying flashing around. 
Application.StatusBar = "Done"
   
=INDIRECT(K$1&"!b20",TRUE)
   
Sheets(Array(3, 4, 5, 6, 7, 8, 9, 10, 11, 12)).Select
   
sTab7 = DialogSheets("dlgTabber").EditBoxes("Edit Box 17").Text
 Grab what is in Edit Box 17 
Cells(Q, 1).Select
   
MsgBox ("That's all folks",64)
 Let the world know you are finished.
Option Explicit Forces you to DIM all variable before using them. Keeps you honest

Updated:  20 October 2001 12:59:14