work smarter with VBA

"We keep moving forward, opening new doors, and doing new things, because we're curious and curiosity keeps leading us down new paths."

- Walt Disney


Send sheet as .pdf

Sub button_click()   Dim DataSti As String Dim Filnavn As String Dim objFolders As Object Set objFolders = CreateObject(“WScript.Shell”).SpecialFolders Dim OutlookPrg As Object Dim OutlookMail As Object Set OutlookPrg = CreateObject(“Outlook.Application”) Set OutlookMail = OutlookPrg.CreateItem(0)   DataPath = objFolders(“desktop”) & Application.PathSeparator Filnavn = Worksheets(“Sheet1”).Range(“D5”).Text  & “.pdf”   ActiveSheet.ExportAsFixedFormat _ Type:=xlTypePDF, _ Filename:=DataPath & Filnavn, _ Quality:=xlQualityStandard, _ IncludeDocProperties:=True, _ IgnorePrintAreas:=False, _ OpenAfterPublish:=False   On Error Resume Next With OutlookMail .To = Worksheets(“Sheet1”).Range(“D9”).Text .CC = “” .BCC = “” .Subject = “Something- ” & Filnavn .Body = “Hey ” &  “Kind regards” & vbCrLf & Worksheets(“Sheet1”).Range(“D3”).Text .Attachments.Add (DataPath & Filnavn) .Display End With On Error GoTo 0   Kill (DataPath & Filnavn)   Set OutlookMail = Nothing Set OutlookPrg = Nothing Set objFolders = Nothing End Sub

a small homemade formula

This formula i use in my work quite a lot.

Please note, that if you want to call the function in VBA, then you have to have the function in a module and not in a regular sheet. It took me a while to figure that one out 🙂  when i got started.

I receive many bank statements with deposits, where the only way to find the correct accounting string is by lookup of the address. The formula returns the position of the first numeric character, so if the address in a cell is ‘High Street 12’ i can easily find the name of the street without the number and do my lookup.

Because only I need the function i haven’t saved it as a plugin, but if you want to make it available to the entire organisation that is probably the way to go.

Public Function MyOwnFind(ByVal cell As String) As Integer

For i = 1 To Len(cell)
Dim currentCharacter As String
currentCharacter = Mid(cell, i, 1)
If IsNumeric(currentCharacter) = True Then
MyOwnFind = i
Exit Function
End If
Next i
End Function


“automatic” running subs

I sometimes get annoyed that i have to manually update Pivot tables and the likes, therefore i hope these can help other people as well. If there is any i have forgotten please comment, i’m still a bit new in the VBA world.


Private sub Worksheet_Deactivate() ‘ what to do when you leave a worksheet

Private Sub Worksheet_SelectionChange(ByVal Target As Range) ‘ Change or do when changes occur in area

Private Sub Worksheet_Change(ByVal Target As Range) ‘ Change or do when changes occur in worksheet

Private sub Worksheet_Activate() ‘ what to do when a sheet opens/ is selected


Force users to save spreadsheet with active macroes.


2 steps, a friend of mine suggested that i put a save as button in the file, that activates the function button F12 (Save as)

If you add the code below in VBA you’ll make sure the file is saved as a .xlsm

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim txtFileName As String

‘1. Check of Save As was used.

If SaveAsUI = True Then

Cancel = True

‘2. Call up your own dialog box.  Cancel out if user Cancels in the dialog box. (“blahh” is the suggested filename)

txtFileName = Application.GetSaveAsFilename(“blahh”, “Excel Macro-Enabled Workbook (*.xlsm), *.xlsm”, , “Save As XLSM file”)

If txtFileName = “False” Then

MsgBox “Action Cancelled”, vbOKOnly

Cancel = True

Exit Sub

End If

‘3. Save the file.

Application.EnableEvents = False

ThisWorkbook.SaveAs Filename:=txtFileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled

Application.EnableEvents = True

End If

End Sub