Ol Monitor does it’s best to restrict the folders it works with to just one, the “Public\Documents\OlMonitor” folder.

And clicking Properties-Global options:

Then select “Sessions” under File Locations:

I finally stumbled across this forum post.
http://www.pstnet.com/forum/Topic1767-5-1.aspx
It was about some psychology software tool but apparently the same principle applies.
That led me to this: http://www.pstnet.com/support/kb.asp?TopicID=1300
Remove string literals.  That’s it.  You may not remember what a string literal is, in your subs or functions, if you put some text within quotes: sName = “Beverly” that is a string literal.  I found that I use these all over the place.  When you record a macro and then look at the code it uses string literals.  The code samples in the macro guide are littered with literals.  So I’d always assumed that this was the proper way to do things.
Anyway so what to do?  You can’t just remove these string literals they are essential.  One easy thing to do is replace anything you can with one of the built in constants.
So instead of using “” use ebNullString.

Sub Test1()
    If x = "" Then
         Exit Sub
    End If

    'Change it to this:   
    If x = ebNullString Then     
         Exit Sub
    End If
End Sub

I was able to do a search and replace and found that I’d used “” all over the place.

If you need even more space take it a step further, replace string literals with constants.

‘For those string literals you create, make a constant instead:

Sub ChooseLoop()
     If sName = "West" Then
        Call WestLoop()
     Else
        Call EastLoop()
     End If
End Sub

'Outside the sub declare a constant instead:   
Const WEST = "West"

Sub ChooseLoop()
     If sName = WEST Then
        Call WestLoop()
     Else
        Call EastLoop()
     End If
End Sub

By replacing just a couple of my commonly used string literals, I gained an extra 37 lines of compile space!

 Public Function MakeCalendar(intStartRow As Integer, intStartCol As Integer, strStartDate As String, strEnddate As String) As Boolean
    'Takes start row and column and prints a calendar. By Eric Ainsworth - www.synapsonic.com
    On Error GoTo Errorhandler
    Dim WeekDays() As String 'little array for S-Sat
    WeekDays = Split("Sun,Mon,Tue,Wed,Thu,Fri,Sat", ",")
    Dim intX As Integer
    Dim intY As Integer
    Dim intCals As Integer
    Dim strMonth As String
    Dim intRow As Integer
    Dim intDay As Integer
    Dim intMonths As Integer
    If Month(strStartDate) = Month(strEnddate) Then
        'Same month
        intMonths = 1
    Else
        ‘Only set up to handle 2 months here.
        intMonths = 2
    End If

    For intCals = 1 To intMonths 'just once if same month
        If intCals = 1 Then 'first month
            strMonth = Month(strStartDate)
        Else
            strMonth = Month(strEnddate)
        End If

        If intCals > 1 Then 'move everythuing over to right
            intStartCol = intStartCol + 7
        End If

        For intY = LBound(WeekDays) To UBound(WeekDays)
            Cells(intStartRow + 1, intStartCol + intY).Value = WeekDays(intY)
            If intY = 3 Then 'put month
                If intCals = 1 Then
                    Cells(intStartRow, intStartCol + intY).Value = Format(strStartDate, "mmm")
                Else
                    Cells(intStartRow, intStartCol + intY).Value = Format(strEnddate, "mmm")
                End If 'end if intcals
            End If 'end if wed

            Range(Cells(intStartRow, intStartCol + intY), Cells(intStartRow + 1, intStartCol + intY)).Select
            Selection.HorizontalAlignment = xlCenter
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = -0.149998474074526
                .PatternTintAndShade = 0
            End With
        Next intY 'next weekday

        intStartRow = intStartRow + 1

        intRow = 0
        For intX = 1 To 31 'day of month
            If Not IsDate(strMonth & " " & Format(CStr(intX), "00") & " " & Year(strStartDate)) Then
                Debug.Print "MakeCalendar: Last day of month " & strMonth & " was: " & intX - 1
                'Debug.Print strMonth & " " & Format(CStr(intX), "00") & " " & Year(strStartDate) & " not a date"
                Exit For
            End If

            intDay = Weekday(strMonth & " " & Format(CStr(intX), "00") & " " & Year(strStartDate)) 'as it is this will break over new years

            Cells(intStartRow + intRow + 1, intDay + intStartCol - 1).Value = intX
            Cells(intStartRow + intRow + 1, intDay + intStartCol - 1).HorizontalAlignment = xlCenter

            If DateDiff("d", strMonth & " " & Format(CStr(intX), "00") & " " & Year(strStartDate), strStartDate) = 0 Or DateDiff("d", strMonth & " " & Format(CStr(intX), "00") & " " & Year(strStartDate), strEnddate) = 0 Then
                Cells(intStartRow + intRow + 1, intDay + intStartCol - 1).Font.Bold = True
            End If

            'Columns(intDay + intStartCol - 1).EntireColumn.AutoFit 'cant do this it messes up stuff above

            Select Case intDay
                Case 1 'sunday
                    Cells(intStartRow + intRow + 1, intDay + intStartCol - 1).Borders(xlEdgeLeft).LineStyle = xlContinuous
                Case 2 'monday
                Case 3
                Case 4 'wed
                Case 5 'thur
                Case 6 'fri
                Case 7 'sat
                        Cells(intStartRow + intRow + 1, intDay + intStartCol - 1).Borders(xlEdgeRight).LineStyle = xlContinuous
                        intRow = intRow + 1
            End Select

        Next intX 'next day

        intStartRow = intStartRow - 1
    Next intCals 'next calendar

    Exit Function
Errorhandler:
    Debug.Print Err.Description & " " & Err.Number
    Resume Next
End Function

This is how you would call it:

Public Sub Test()
    Debug.Print MakeCalendar(1, 1, "5/1/2012", "5/31/2012")
End Sub

DragInfo now supports synchronizing with a plaintext file.  Changes to the xml file will update the plaintext file and vice versa.
Any snippets that exist in the xml file already or that you create will also be created within the text file.
On the other hand, DragInfo ignores any info in the text file that does not match a tab title.
Lets say you have you have a tab named “Dog”.  If a line is detected in the plaintext file with the word “Dog” (no other words on same line), the info below it will be treated as the snippet info.  The program knows the snippet for “Dog” ends when it sees more than 2 blank lines, the end of the file, or the name of another tab.
This program was written to store and easily drop test kit lot numbers and expirations that change frequently.
In our lab some prefer using the simple plaintext file and others like the new way.  So the plaintext sync options ensures that if one tech updates the lot numbers in either the program or the text file, those changes will by synced.  This way we don’t have to change the info in two places every time we switch kit lots.
The plaintext option is also a great way to have your info backed up in a simple format.

Periodic file change checks:

Both the text file and the xml file are checked every minute to see if they’ve been updated.
If they have, DragInfo will notify you.  This is useful if several instances of the program on different pc’s are sharing the same file.

Here is another useful macro for copying data from multiple workbooks into one workbook. At the end of the month billing needs a report with all the months charges listed. We have been creating a workbook daily with the day’s charges listed. Now we have to collate all those workbooks into one workbook. Again it’s a tedious process in need of automation.

To work this macro needs a sheet to copy to. I take the easy road and create a workbook name MasterWorkbook. I run the macro and it copies all the month’s workbooks to the MasterWorkbook. Then I save MasterWorkbook with a new name denoting the month. this way the original remains blank for next month. To work all the workbooks/sheets need to be in one folder. It copies all data from all workbooks in that folder to one.

How to get a list of workbooks in a folder:

We have gathered all the month’s files in one folder. The first step is to get a list of all the excel workbooks in this folder.

Sub AggregateReports()
    'Get a folder full of reports and put them all into one sheet.
    'Get the folder from user.
    On Error GoTo ErrorHandler

    Dim fldr As FileDialog
    Dim strFolder As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select the Folder where all the daily reports reside"
        .AllowMultiSelect = False
        .InitialFileName = strPath
        If .Show <> 0 Then
            strFolder = .SelectedItems(1)
        Else 'Cancelled
            strFolder = ""
        End If
    End With

    Debug.Print "Folder was: " & strFolder
    Application.ScreenUpdating = False

We have the folder name now we need to get a list of only the excel files within that folder. We do this with the old Dir command. If you recall in MS-Dos dir used to list all the files in a folder. It’s almost the same in vba, except Dir returns the name of the first file and must be called again to get the next.

    'Get all filenames within folder.
    Dim Files() As String
    ReDim Files(-1 To -1)
    ThisWB = ThisWorkbook.Name
    Filename = Dir(strFolder & "\*.xls", vbNormal)
    Do Until Filename = ""
        If Filename <> ThisWB Then
            If UBound(Files) = -1 Then
                ReDim Files(0 To 0)
                If Filename = "" Then
                Else
                    Files(0) = Filename
                End If
            Else
                ReDim Preserve Files(0 To UBound(Files) + 1)
                Files(UBound(Files)) = Filename
            End If

            Debug.Print "Added: " & Filename
        Else
            Debug.Print "Excluded this workbook: " & Filename
        End If
        Filename = Dir()
    Loop

We now have a list of files but sadly they are in no particular order. A simple sort of the files will ensure that when we loop through them (as long as you have named them all in the same format with a date) the days will get copied in order.

How to do a quick sort in excel vba:

Private Sub QuickSort(strArray() As String, intBottom As Integer, intTop As Integer)
    Dim strPivot As String, strTemp As String
    Dim intBottomTemp As Integer, intTopTemp As Integer

    intBottomTemp = intBottom
    intTopTemp = intTop

    strPivot = strArray((intBottom + intTop) \ 2)

    While (intBottomTemp <= intTopTemp)

        'comparison of the values is a descending sort
        While (strArray(intBottomTemp) < strPivot And intBottomTemp < intTop)
            intBottomTemp = intBottomTemp + 1
        Wend

        While (strPivot < strArray(intTopTemp) And intTopTemp > intBottom)
            intTopTemp = intTopTemp - 1
        Wend

        If intBottomTemp < intTopTemp Then
            strTemp = strArray(intBottomTemp)
            strArray(intBottomTemp) = strArray(intTopTemp)
            strArray(intTopTemp) = strTemp
        End If

        If intBottomTemp <= intTopTemp Then
            intBottomTemp = intBottomTemp + 1
            intTopTemp = intTopTemp - 1
        End If

    Wend

    'the function calls itself until everything is in good order
    If (intBottom < intTopTemp) Then QuickSort strArray, intBottom, intTopTemp
    If (intBottomTemp < intTop) Then QuickSort strArray, intBottomTemp, intTop

End Sub

This is a great and simple quicksort function but how do we use it? It’s simple:

    'NOTE: We are still in sub AggregateReports here:
    'Files come in all willy nilly, sort them by date
    QuickSort Files, LBound(Files), UBound(Files)

    Dim intX As Integer
    For intX = LBound(Files) To UBound(Files)
        Debug.Print "After Sort: " & Files(intX)
    Next intX

Now we have our list of files we just need to loop through it and copy them to the MasterWorkbook:

    'NOTE: we are still in sub AggregateReports here:
    Dim wkb As Workbook
    Dim intFinalRow As Integer
    Dim intRow As Integer
    Dim blnHeaderDone As Boolean

    For intX = LBound(Files) To UBound(Files)
            Set wkb = Workbooks.Open(Filename:=strFolder & "\" & Files(intX))
            wkb.Activate
            With wkb.Sheets(1)
                Set LastCell = .Cells.SpecialCells(xlCellTypeLastCell)
                .Activate
                intFinalRow = Range("A65536").End(xlUp).Row  '
                For intRow = 2 To intFinalRow
                    If blnHeaderDone = False Then
                        'We only want to copy the header row once so we do it here and set variable to True
                        Rows(intRow - 1).EntireRow.Copy (Sheets(1).Range("a65536").End(xlUp).Offset(0, 0))
                        blnHeaderDone = True
                    End If
                    Rows(intRow).EntireRow.Copy (Sheets(1).Range("a65536").End(xlUp).Offset(1, 0))
                    If intRow = 2 Then 'This add's a 'Begin' comment to the first cell of that day.
                        Sheets(1).Range("a65536").End(xlUp).Offset(0, 7).AddComment ("Day " & CStr(intX) & " Begin: " & Files(intX))
                    End If
                    If intRow = intFinalRow Then 'Add end
                        Sheets(1).Range("a65536").End(xlUp).Offset(0, 7).AddComment ("Day " & CStr(intX) & " End: " & Files(intX))
                    End If

                Next intRow

            End With
            wkb.Close False

    Next intX 'next file.
    Application.ScreenUpdating = True

    Exit Sub
ErrorHandler:
    Debug.Print Err.Number & " " & Err.Description & " " & Erl
    MsgBox Err.Number & " " & Err.Description & " " & Erl
End Sub

And voila! Another 30 minutes saved!

You can download the workbook with macro here: MasterWorkbook

[ad name=”Synap blog wide”]

Instead of making this into a full-blown tutorial I will just list the sticking points and post the macro.  If you have any questions just add a comment.

What to do when you can’t use Personal.xlsb to store your macros: (only for people using Personal.xlsb otherwise skip this)

The Powervision app exports the reports to Excel, but it’s not loading my Personal macros file.  This is because it’s running a Citrix Excel (I’m guessing) instead of using my pc’s excel.  For this you just have to put your macro code into a workbook, and then load that workbook with the Citrix excel along with the exported report.  Your macro code can still do everything it needs to, having Personal macros is just a convenience.  I have named my workbook “ProcessTATexportsMacroXl2003.xls”. It doesn’t actually have or import any data, it just contains my macro code.

The app exports each report to a separate workbook, this leads to another problem:

How to access sheets from a different workbook:

This isn’t really a problem but most are used to working at the sheet level in Excel. You just have to step back to the Workbook level.  Here’s how:

Each workbook that is loaded in Excel is given an index number. So we just cycle through the numbers:

    Dim intBook As Integer
    
    For intBook = 1 To Application.Workbooks.Count
        With Workbooks(intBook).Sheets(1)
 	 'Do whatever you need to do with sheet here
        End With
    Next intBook

Great. Next problem, the report gives the times in a DAYS HOURS:MINUTES format like this 0 00:00

That leading 0 is going to be troublesome. We can just cut it off. (If you wanted to be super careful you could make sure it’s not 0 and if not add it to your calculation).

Right(Cells(intRow, 6).Text, 5

Next problem, we have a list of times in Excel and we need to get the average time. The Excel AVERAGE function doesn’t work. We can use the datediff function to give us total minutes instead of hours and minutes.

How to calculate elapsed time when given hours:minutes in Excel:

This is also

how to calculate an average time from a list of times.

        Dim intFinalRow As Integer
        intFinalRow = Range("A65536").End(xlUp).Row

        For intRow = 1 To intFinalRow

                'intTime = CInt(Trim(Replace(Replace(Cells(intRow, 6).Value, ":", ""), " ", "")))  'WRONG!
                'This seems like it would work, just replace out all the colons and commas and get to the raw value, BUT
                'if the time is over an hour you get 1:15 which results in: 115.  Do it the right way and treat it as a date
                'you will get the correct number of minutes: 75
                strTime = DateDiff("n", 0, Right(Cells(intRow, 6).Text, 5))
                
                'Add a cell next to it with the tat time in minutes.
                Cells(intRow, 7).Value = strTime

        Next intRow

    'Now the Excel average function will work with our list of times since they are a whole number in minutes.
    Cells(intFinalRow + 1, 7).FormulaR1C1 = "=AVERAGE(R[-" & intFinalRow - 2 & "]C:R[-1]C)"

The last problem we run into is that one of the sheets contains TAT’s from both PT’s and aPTT’s, so we can’t just loop through the whole thing like the others. To solve this I added some checking and saved the beginning and ending row of each set. To see this and the entire working example code download the example file below.

ProcessTATExample.zip

Adding a custom macro button to the Excel 2007 quick access toolbar:

The first thing to do is make sure you’ve been putting your macro code in the right place.  If you put the code in the workbook it will be available to anyone who opens that file.  But in this example we open and process a new workbook every day.  So we should put the code in our personal macro file.  This makes it available to you every time you open Excel.  Open the visual basic editor to look at your files:
  If you have been putting your code in a workbook, or someone shared a workbook with you with macros in it, you can simply copy and paste the code into ‘Module1’ of your PERSONAL.XLSB file.
(Note: Don’t have a PERSONAL.XLSB?  Here are instructions on creating one: How to create a Personal.xlsb )

After making sure the code is in personal.xlsb, it is easy to add quick access buttons to your macros.
Click on the down arrow button on your quick access toolbar:

Click ‘More Commands…’
From the ‘Choose commands from’ drop-down select ‘Macros’

All of the macros in your Personal.xlsb file should be listed:

Now you can simply click each one and add it to your toolbar.
The toolbar ends up looking something like this:

Go back to the quick access options by clicking ‘More Commands’ again.  You can change the icon for any item by selecting it and clicking the ‘Modify’ button.  Here is how my toolbar looked after modifying:

Well that’s it!  Now a task that took 5-10 minutes per report can be done in about 30 seconds.  What will you do with all your extra time?

Can you think of any improvements for this set of macros?

Back to tutorial 1

Download all the macros covered in this tutorial:

Here is my Personal.xlsb file containing a slightly improved version of all the macros in this tutorial: PERSONAL.XLSB

Here is an excel workbook with fake patients you can test the macros out on: FakeBillingReport.xlsx

Here is a macro-enabled excel workbook with the code in the workbook: FakeBillingReport.xlsm (macros inside) (in case you had trouble getting to the macros in PERSONAL.xlsb).