General
Application.ScreenUpdating = False ‘ Turn off screen updating Application.ScreenUpdating = True ‘ Turn on screen updating
Application.StatusBar = "Archiving Data..." ‘ Display a message in the Status Bar
Application.StatusBar = False ‘ Remove displayed message from Status Bar
Application.CutCopyMode = False ‘ Clears the currently copied cells from the clipboard
Application.DisplayAlerts = False ‘ Turns off most of Excel’s warning messages
ActiveSheet.DrawingObjects.Select ‘ Selects all the shape objects (text boxes, lines, etc.) on the active sheet.
ActiveSheet.PageSetup.LeftHeader = Format(Worksheets("Sheet2").Range("B5").Value) ‘ Puts the value of cell B5 on Sheet2 in the left header of the active sheet.
Sheets("Compiler").Select ‘ Select sheet named Compiler
Sheets(“ProjHist”).Visible = True ‘ Unhide the sheet named ProjHist
Sheets(“ProjHist”).Visible = False ‘ Hide the sheet named ProjHist
Sheets(“ProjHist”).Visible = xlVeryHidden ‘ Hide the selected sheet and don’t display it in the Format -> Sheets -> Unhide list
Sheets("Sheet1").ScrollArea = "B2:D50" ‘ Sets the scroll area on Sheet1 so the user cannot activate any cells outside of B2:D50
Sheets("Sheet1").ScrollArea = "" ‘ Sets the scroll area on Sheet1 back to normal
Sheets(Array("Instructions", "Equations", "Input-Main", "Input-Comments")).Select ‘ Select specific sheets…
ActiveWindow.SelectedSheets.Delete ‘…and delete them (it is a good idea to turn off warnings (DisplayAlerts) first)
Application.Goto Reference:=Range("RqmtsID1") ‘ Go to the cell named RqmtsID1 (doesn’t need to be on the active sheet)
Application.Goto Reference:=Range("RqmtsID1"), Scroll:=True ‘ Go to cell named RqmtsID1 and scroll so it’s visible.
Cells(Row1, Col1).Select ‘ Select the cell at Visual Basic variables named Row1, Col1 (B3 if Row1=3 & Col1=2)
Cells.Select ‘ Selects all the cells on the active sheet.
Range("A1").Select ‘ Select cell A1 on the active sheet
Range("A1").Copy Range("B1") ‘ Copies the contents of A1 and pastes it in B1
Range(PrintRng).Select ‘ Select the range identified by the VB variable PrintRng
Range("CompLCol").Select ‘ Select the cell named CompCol on the active sheet Range(Cells(Row2, Col1), Cells(Row2, Col2)).Select ‘ Select the range of cells defined by the variable names
Range(ActiveCell.Offset(1, 0), Cells(Row2, Col1)).Select ‘ Select range one row below current cell to cells defined by variables Range(Selection, Selection.End(xlDown)).Select ‘ Select from the current selection to the end (below the current selection)
Ans = Cells(CRow, CCol).Value ‘ Sets Ans equal to the value in the cell at row CRow and column CCol Col1 = ActiveCell.Column ‘ Set variable named Col1 to the current column number
Col2 = ActiveCell.Column + 1 ‘ Set variable named Col2 to the number of the column to the right of the current column
Row1 = ActiveCell.Row ‘ Set variable named Row1 to the current row number
ActiveCell.FormulaR1C1 = "=R[-1]C+1" ‘ Enters a formula in the active cell (B5 = B4+1)
TNow = “=Now()” ‘ Typical equation in VB using Excel functions. This one sets VB variable TNow equal to the current date/time.
ActiveCell.Offset(-1, 0).Select ‘ Select cell above current cell
ActiveCell.Offset(NRows, 0).Select ‘ Select cells NRows below current cell (positive=down and right)
ActiveCell.End(xlDown).Select ‘ Select the last cell in current column (before an empty cell is found). Others are xlUp, xlToLeft, xlToRight
ActiveCell.CurrentRegion.Select ‘ Selects the current region
Selection.SpecialCells(xlCellTypeLastCell).Select ‘ Selects the cell in the last row and column that are in use on the current sheet
Pos = InStr(1, LookInStr, LookForStr, 1) ‘ “InStr” looks for one string inside another (Pos, LookInStr and LookForStr are variable names)
Selection.Find(What:=UserID, After:=ActiveCell, LookIn:=xlValues, Lookat:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False).Activate ‘ Looks for string in a range of cells, another option is Lookat:=xlWhole
Selection.Sort Key1:=Range("CInfoPI1"), Order1:=xlAscending, Key2:=Range("CInfoDate1"), _
Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom ‘ Sorts current region based on two selection criteria named CinfoPI1 &CinfoData1. Data has header row.
Selection.ClearContents ‘ Clear contents of selected cells
Selection.EntireRow.Delete ‘ Delete entire row(s) for which cells are currently selected
Selection.Cut Destination:=Range(Cells(Row1, Col1), Cells(Row2, Col2)) ‘ Cut selected cells and inset at designated range Selection.Insert Shift:=xlDown ‘ Insert cells (number depending on number of cells selected) and shift cells below them down Selection.Value = Selection.Value ' Converts current range to values (like Copy, Paste-Special Values but doesn't crash Excel '97)
Selection.PasteSpecial Paste:=xlValues ‘ Paste just the values Selection.PasteSpecial Paste:=xlFormulas ‘ Paste just the formulas
Selection.PasteSpecial Paste:=xlFormats ‘ Paste just the formats Selection.SpecialCells(xlCellTypeFormulas, 1).Select ‘ Of selected cells, select only formulas that are numbers Selection.SpecialCells(xlCellTypeConstants, 2).Select ‘ Of selected cells, select only constants that are text Selection.SpecialCells(xlCellTypeConstants, 4).Select ‘ Of selected cells, select only constants that are logicals Selection.SpecialCells(xlCellTypeFormulas, 16).Select ‘ Of selected cells, select only formulas that = errors Selection.SpecialCells(xlCellTypeVisible).Select ‘ Of selected cells, select only visible cells
=SERIES(,'Forecast Alert.xls'!Month_Range,'Monthly Data'!$T$519:$AW$519,1) ‘ Using range names in a chart series
=========================================================================
Copy and Paste
Range("A1").Select Selection.Copy Range("A2").Select ActiveSheet.Paste
=========================================================================
Passing arguments to another procedure
Sub One()
‘ This procedure passes two arguments to Sub Two
arg1 = 10
arg2 = 20
Call Two(arg1, arg2)
End Sub
Sub Two(arg1, arg2)
‘ Gets arguments from Sub One and puts the answer in cell A1 of the active sheet.
Ans = arg1 + arg2
Range("A1").Value = Ans
End Sub
=========================================================================
' Private subroutines won’t show up in the macro list. Also, they can only be called by procedures in the same module.
Private Sub MySub ()
‘ Code…
End Sub
=========================================================================
Adding a range name
General:
ThisWorkbook.Names.Add Name:="NewName", RefersTo:="=$A$1:$C$10", Visible:=True ‘ If Visible:=False, the name will not be displayed in the Names dialog box. If you add a name that already exists, Excel will replace the old name with the new name. An error will not be generated.
In a Procedure:
Dim NewRng As Range
' Code to define NewRng (something like…)
Set NewRng = Selection.CurrentRegion
ThisWorkbook.Names.Add Name:="NewName", RefersTo:=NewRng
==============================================================
Page and print range setup
General:
ActiveSheet.PageSetup.CenterHeader = "Approved returns for " & RptCust & " for " & RptMonth ‘ Update header of active worksheet
ActiveSheet.PageSetup.PrintArea = "RqmtsDataPrnt" ‘ Sets the print range to the workbook range named RqmtsDataPrnt
In a Procedure:
Dim PrintRng As Range ‘ Define the VB variable PrintRng as a range
‘ Code…
Application.Goto Reference:=("CRptHome") ‘ Go to a cell in the region to be printed
Set PrntRng = Selection.CurrentRegion
ActiveWorkbook.Names("CRptPrntRng").RefersTo = PrntRng
ActiveSheet.PageSetup.PrintArea = "CRptPrntRng" ‘ Assumes some range in the workbook has already been defined as “CRptPrntRng”
=========================================================================
Password protection of worksheet
ActiveSheet.Protect Password := "drowssap" ‘ Protect the active sheet with a password
ActiveSheet.Unprotect Password := "drowssap" ‘ Unprotect the active sheet with a password
=========================================================================
Message Boxes
Message = "The information in row " & CurRow & " does not have a Project Identifier."
MsgBox Message, vbOKOnly
Ans = MsgBox("Project '" & ProjIdent & "' is about to be deleted. Press OK to confirm deletion or Cancel to abort.", vbOKCancel)
If Ans = vbCancel Then GoTo AA:
Selection.EntireRow.Delete ‘ Code…
MsgBox "Line 1 of message." & vbCrLf & "Line 2 of message." ' vbCrLf adds a carriage return and line feed between the two lines
=========================================================================
' The following four commands come in handy when you want to run a VB procedure and return to the sheet and cell that were active before running it. Put the first two at the start of the procedure and the last two at the end.
Set StartSheet = ActiveSheet ‘ Set variable StartSheet equal to the name of the active sheet
Set StartCell = ActiveCell ‘ Set variable StartCell equal to the active cell.
‘ Code…
StartSheet.Activate ‘ Return to sheet named StartSheet
StartCell.Select ‘ Return to the cell named StartCell
=========================================================================
Example of Do-Until
Do Until CRow > LRow
If ActiveCell.Value = "" Then
CurRow = ActiveCell.Row
Message = "The information in row " & CurRow & " on the ChgData-SW sheet does not have a Project Identifier."
MsgBox Message, vbOKOnly
MissingID = True
Exit Do
Else: End If
ActiveCell.Offset(1, 0).Select
CRow = ActiveCell.Row
Loop
=========================================================================
Error Trapping
‘ Code…
On Error GoTo 80
‘ More Code…
70: Sheets("Output").Activate
On Error GoTo 0 ‘ Disables the enabled error handler in the current procedure ‘ More Code… Exit Sub
80: UserName = "**Not Found**"
Resume 70
=========================================================================
Find a value in a list
ADCPN = Cells(I, OutADCPNCol).Value ‘ The value you are looking for
Application.Goto Reference:=Range("AnaMatNoRng") ‘ Select the range to look in
Selection.Find(What:=ADCPN, After:=ActiveCell, LookIn:= xlValues, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:= xlNext, MatchCase:=False).Activate ‘ Finds the value and activates the cell
CRow = ActiveCell.Row ‘ Records the row the value is in
=========================================================================
Examples of If-Then-Else…
If DateNow > HistLast + DateInterval Then
Application.StatusBar = "Archiving Data…" ‘ Code…
Else
‘ More code… End If
‘ More code…
--or --
If X > Y then Z=1 Else Z=2
=========================================================================
Example of ElseIf
If CustomerState="TX" Then
SalesTax=.0825
ElseIf CustomerState="VA" Then
SalesTax=.0615
Else
SalesTax=0
End If
=========================================================================
Example of For Each
Range(Cells(FRow, RPCol), Cells(LRow, RPCol)).Select
For Each x In Selection
If x.Value = "" Then
Cells(x.Row, MCol).Value = "Y”
Else: End If
Next x
=========================================================================
Reset the Last Cell
' The following procedure will reset the last cell on each sheet in the workbook when the workbook is saved. It is set up to run on save because it clears the undo stack (so you can’t undo after running it), but so does Save.
Private Sub Workbook_BeforeSave _
(ByVal SaveAsUI As Boolean, Cancel As Boolean)
For Each Sh In ThisWorkbook.Worksheets
X = Sh.UsedRange.Rows.Count
Next Sh
End
=========================================================================
Importing data from a web page
Dim QT As QueryTable
‘ Code…
URLStr = "http://epm.adc.com/4DACTION/EPM_MgrRpt_Excel/userID=" & LoginID & "&rptGroup=y" 'The URL
Set QT = ActiveSheet.QueryTables.Add(Connection:="URL;" & URLStr, Destination:=Range("InData"))
' InData is a named range in Excel and is the starting cell for the imported data.
With QT
.Name = MyName
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
End With
' Refresh the query
QT.Refresh
=========================================================================
Example of a progress indicator (%)
Sub X () ‘ Code…
Do Until CRow > LRow
DispRow = Int(((Int((CRow - FRow) / DispIncrement) * DispIncrement) / (LRow - FRow)) * 100)
Application.StatusBar = "Updating: " & DispRow & "% complete"
‘ Code…
CRow = CRow + 1
Loop
‘ Code…
End
=========================================================================
Sub CopyPicture()
' Copies the print range of the active sheet to the clipboard as a picture.
Set StartCell = ActiveCell
ActiveSheet.Range("Print_Area").Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
StartCell.Select
End Sub
© JAY DEITCH 2020