Copy

Newsletter by jkp-ads.com

View this email in your browser

jkp-ads.com Newsletter for December 2015

We're on the verge of starting a new year so let me take this opportunity to wish you a very, very happy and prosperous 2016!.

Some useful Excel VBA routines

Since I do Excel and VBA development for a living, over time I have gathered quite a library of useful VBA routines. I'd like to share some with you today.

1. Opening a selection of files and importing all data from their worksheets into one worksheet
If you ever get into a situation where you need to consolidate data from multiple workbooks with a similar layout into one master worksheet, perhaps this example macro may help:

Sub ConsolidateFiles()
    Dim lCount As Long
    Dim vFileName As Variant
    Dim sPath As String
    Dim lFilecount As Long
    sPath = "c:\windows\temp\"
    ChDrive sPath
    ChDir sPath
    vFileName = _
        Application.GetOpenFilename("Microsoft Excel files (*.xls*),*.xls*", _
        , "Please select the file(s) to consolidate", , True)
    If TypeName(vFileName) = "Boolean" Then Exit Sub
    For lCount = LBound(vFileName) To UBound(vFileName)
        ProcessFile CStr(vFileName(lCount))
    Next
End Sub

Sub ProcessFile(sFileName As String)
    Dim oSh As Worksheet
    Workbooks.Open sFileName
    For Each oSh In Worksheets
        oSh.UsedRange.Copy
        With ThisWorkbook.Worksheets("AllData")
            .Range("c" & _
                .Rows.Count).End(xlUp).Offset(1).PasteSpecial _
                xlPasteValuesAndNumberFormats
            .Range(.Range("A" & .Rows.Count).End(xlUp).Offset(1), _
                .Range("C" & .Rows.Count).End(xlUp).Offset(0, -2)).Value _
                = ActiveWorkbook.FullName
            .Range(.Range("B" & .Rows.Count).End(xlUp).Offset(1), _
                .Range("C" & .Rows.Count).End(xlUp).Offset(0, -1)).Value _
                = oSh.Name
        End With
    Next
    Application.CutCopyMode = False
    ActiveWorkbook.Close False
End Sub

Does a named object exist in a collection?
Often you need to know whether a certain named object exists within a collection, for instance: does the workbook have a worksheet called "AllData"? This little function returns True of the named object exists:

Public Function IsIn(oCol As Object, sName As String) As Boolean
'-------------------------------------------------------------------------
' Purpose   : Returns True when named object exists in Collection
'-------------------------------------------------------------------------
    Dim oObj As Object   
    On Error Resume Next
    Err.Clear
    Set oObj = oCol(sName)
    IsIn = (Err.Number = 0)
End Function

Finding cells using a particular cellstyle
When I am building a model I tend to use cell styles. It frequently happens that I am not sure where a particular cellstyle has been applied. This little routine runs through all sheets and all cells and stops if it finds a cell with a style that has a stylename ending with "Input":

Sub FindaStyle()
    Dim oSh As Worksheet
    Dim oCell As Range
    For Each oSh In ThisWorkbook.Worksheets
        For Each oCell In oSh.UsedRange.Cells
            If oCell.Style Like "*Input" Then
                Application.GoTo oCell
                Stop
            End If
        Next
    Next
End Sub

Listing cell styles
Similarly, I like to keep a list of cell styles so I can quickly see which I have in the model. The list is created on a newly inserted worksheet:

Sub ListStyles()
    Dim oSt As Style
    Dim lCount As Long
    Dim oStylesh As Worksheet
    Set oStylesh = ThisWorkbook.Worksheets.Add
    With oStylesh
        lCount = 1
        For Each oSt In ThisWorkbook.Styles
            lCount = lCount + 1
            .Cells(lCount, 1).Style = oSt.Name
            .Cells(lCount, 1).Value = oSt.Name
            .Cells(lCount, 2).Style = oSt.Name
        Next
    End With
End Sub

Check whether a folder exists on a drive and create it if not
Pretty often, VBA projects involve some sort of file handling. Along these lines it is often necessary to check whether a folder exists and if not, have it created. The two routines below handle this task. Note that this routine does not work with UNC paths (paths that resemble \\servername\folder\subfolder).

Function CheckPath(sPath As String) As Boolean
    If FolderExists(sPath) = False Then
        AddPath sPath
        If CheckPath(sPath) Then
            CheckPath = True
        Else
            CheckPath = False
        End If
    Else
        CheckPath = True
    End If
End Function

Sub AddPath(sPath As String)
    Static bErrMsg As Boolean
    On Error GoTo locErr
    Dim sTemp As String
    Dim iPos As Integer
    Dim sCurdir As String
    sCurdir = CurDir
    '    ChDrive sPath
    SetUNCPath sPath
    If Right(sPath, 1) <> Application.PathSeparator Then
        sPath = sPath & Application.PathSeparator
    End If
    If FolderExists(sPath) Then GoTo TidyUp
    iPos = 3
    While iPos > 0
        iPos = InStr(iPos + 1, sPath, Application.PathSeparator)
        sTemp = Left(sPath, iPos)
        If sTemp = "" Then GoTo TidyUp
        If FolderExists(sTemp) = False Then
            MkDir sTemp
        Else
            ChDir sTemp
        End If
    Wend
TidyUp:
    If sCurdir <> CurDir Then
        ChDrive sCurdir
        ChDir sCurdir
    End If
    bErrMsg = False
    Exit Sub
locErr:
    If Err.Number = 76 Or Err.Number = 68 Then
        If Not bErrMsg Then
            MsgBox "Path " & sCurdir & _
                " does not exist, could not restore default folder.", _
                vbCritical + vbOKOnly, GCSAPPNAME
            '76: Current dir seems to have disappeared!
            '68: drive hasbeen removed
            bErrMsg = True
        End If
        Resume Next
    End If
End Sub

 

Excel Events, courses

Financial modelling with Excel
Together with Tony de Jonker I will be hosting this in-house training on February 2, 2016.

Advanced Excel VBA
On February 16 and 23 I will be conducting an in-house training covering advanced VBA subjects such as Error handling, Userform design, Class modules.


The dates for our famous Amsterdam Excel Summit have been set! Join us on May 26th and 27th, 2016 in Amsterdam for the third Amsterdam Excel Summit. This time the Summit itself is a one-day event but we have added a post-conference training day: The Excel Charting And Dashboard Masterclass. If you would like to be informed about this event, make sure you visit our event page, where you can register for updates.


If coming to our Amsterdam Excel Summit is too much of a trip to you, consider visiting the "Excel Summit South" by our Australian colleagues!

Auditing of Formulas made easy

Check out our RefTreeAnalyser
the ultimate Excel formula auditing tool.
 

Mission-critical Excel Model Crashes

Do you have mission-critical Excel files that cause problems? Consider our Excel File Remediation Utility
.
 

Nederlandse cursus: Excel VBA voor Financials

Kost uw maandrapportage u vele uren saai en repeterend werk? Dan is het de hoogste tijd voor onze cursus Excel VBA voor Financials!.
 
Copyright © 2015 JKP Application Development Services, All rights reserved.


unsubscribe from this list    update subscription preferences 

Email Marketing Powered by Mailchimp