Blog

  • Excel Parser

    I had written my own but it had a bug. Then I found this code below on this site.
    It gives credit to John Walkenbach who writes, bar none, the best books on Excel.

    Public Function ExtractElement(Txt, n, Separator) As String
    ' Returns the nth element of a text string, where the
    ' elements are separated by a specified separator character
    Dim Txt1 As String, temperament As String
    Dim ElementCount As Integer, i As Integer
    Txt1 = Txt
    ' If space separator, remove excess spaces
    If Separator = Chr(32) Then Txt1 = Application.Trim(Txt1)
    ' Add a separator to the end of the string
    If Right(Txt1, Len(Txt1)) <> Separator Then _
    Txt1 = Txt1 & Separator
    ' Initialize
    ElementCount = 0
    TempElement = ""
    ' Extract each element
    For i = 1 To Len(Txt1)
    If Mid(Txt1, i, 1) = Separator Then
    ElementCount = ElementCount + 1
    If ElementCount = n Then
    ' Found it, so exit
    ExtractElement = TempElement
    Exit Function
    Else
    TempElement = ""
    End If
    Else
    TempElement = TempElement & Mid(Txt1, i, 1)
    End If
    Next i
    ExtractElement = ""
    End Function
    


    And the following function returns nothing more than the number of elements you get when you cut a string according to a particular delimiter.

    Public Function ExtractElementCount(Txt, Separator) As String
    ' Returns the number of different elements in a string
    ' separated by a specified separator character
    ' This is useful if you are, for example trying to grab the last element or the second to last.
    Dim Txt1 As String, temperament As String
    Dim ElementCount As Integer, i As Integer
    Txt1 = Txt
    ' If space separator, remove excess spaces
    If Separator = Chr(32) Then Txt1 = Application.Trim(Txt1)
    ' Add a separator to the end of the string
    If Right(Txt1, Len(Txt1)) <> Separator Then _
    Txt1 = Txt1 & Separator
    ' Initialize
    ElementCount = 0
    TempElement = ""
    ' Extract each element
    For i = 1 To Len(Txt1)
    If Mid(Txt1, i, 1) = Separator Then
    ElementCount = ElementCount + 1
    End If
    Next i
    ExtractElementCount = ElementCount
    End Function
    

    Footnote

    I see that John Walkenbach has a post about The Versatile Split Function

    VBA’s Split function, introduced with Excel 2000, can simplify many programming tasks. This function accepts a text string, and returns a zero-based variant array that contains the elements of the string (you specify the character that delimits the elements).

    And then you can replace the ExtractElement with just this! Wow!

    Function ExtractElement(str As String, n As Integer, sepChar As String) As Variant
    ' Returns the nth element from a string,
    ' using a specified separator character
    Dim x As Variant
    x = Split(str, sepChar)
    If n > 0 And n - 1 < = UBound(x) Then
    ExtractElement = x(n - 1)
    Else
    ExtractElement = ""
    End If
    End Function
    


    And in case you haven’t had enough you can just do a word count with this.

    Function WordCount(txt as String) As Long
    ' Returns the number of words in a string
    Dim x As Variant
    txt = Application.Trim(txt)
    x = Split(txt, " ")
    WordCount = UBound(x) + 1
    End Function
    


    There are some more examples on the j-walk site.

    • extract a path or a filename from a full filespec
    • Counting specific characters in a string
    • Finding the longest word
  • Calgary Census 2015 Fail

    Update: I went to the site on the last day and it worked so I did it. That means they won’t be coming to our door to manually do it. I do see that the success rate wasn’t good though for online census filler inners.

    About one-fifth of Calgary households filled out census forms online by midday Friday, about half the participation rate the city’s census leader had hoped for.

    I received the request by regular mail to do the online City of Calgary census. Like a good citizen, I went online to do it and …

    Calgary Census Fail

  • Excel XOR

    Excel 2010 doesn’t have an XOR function. The newer versions do. I have needed this form of logic a couple of times recently and I found a good tip here.

    XOR works like this.

    A B Result
    1 1 0
    1 0 1
    0 1 1
    0 0 0

    So, if you don’t have an XOR function you can write a long version of the XOR as follows

    =OR(AND(NOT(A),B),AND(A,NOT(B)))
    

    This is how the XOR operation is defined if you study boolean logic. I did 25 years ago.

    But there is a clever way to do it in Excel.

    The web page lined above noted that the equivalent can be done from the observation that XOR is nothing but <> (the not equal to sign).

    So, instead of going crazy with brackets writing the lengthy formula above. you can just use

    =A<>B
    

    One aside that I found out. You need to be careful with your brackets. I found out that

    This

     =IF(B4=""<>I4<>"","",1)
    

    Is not the same as this

    =IF((E15="")<>(L15<>""),"",1)
    

    Hint: Use the second form with the extra brackets.

  • Clean Up and Assign Template

    Sub cleanup()
    '
    ' cleanup Macro
    '
    'With ActiveDocument.Styles(wdStyleNormal).Font
        With ActiveDocument.PageSetup
            .LineNumbering.Active = False
            .Orientation = wdOrientPortrait
            .TopMargin = InchesToPoints(0.7)
            .BottomMargin = InchesToPoints(0.7)
            .LeftMargin = InchesToPoints(1)
            .RightMargin = InchesToPoints(1)
            .Gutter = InchesToPoints(0)
            .HeaderDistance = InchesToPoints(0.4)
            .FooterDistance = InchesToPoints(0.4)
            .PageWidth = InchesToPoints(8.5)
            .PageHeight = InchesToPoints(11)
            .FirstPageTray = wdPrinterDefaultBin
            .OtherPagesTray = wdPrinterDefaultBin
            .SectionStart = wdSectionNewPage
            .OddAndEvenPagesHeaderFooter = False
            .DifferentFirstPageHeaderFooter = False
            .VerticalAlignment = wdAlignVerticalTop
            .SuppressEndnotes = False
            .MirrorMargins = False
            .TwoPagesOnOne = False
            .BookFoldPrinting = False
            .BookFoldRevPrinting = False
            .BookFoldPrintingSheets = 1
            .GutterPos = wdGutterPosLeft
        End With
        With ActiveDocument
            .UpdateStylesOnOpen = True
            .AttachedTemplate = _
                "\pathtotemplatetemplate.dotx"
            .XMLSchemaReferences.AutomaticValidation = True
            .XMLSchemaReferences.AllowSaveAsXMLWithoutValidation = False
        End With
    End Sub
    
  • Document Clean Up

    Here’s a general bunch of stuff to clean up a document inherited from someone.

    Sub docfix()
    '
    ' docfix Macro
    '
    '
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        With Selection.Find
            .Text = " ^t^t"
            .Replacement.Text = " "
            .Forward = True
            .Wrap = wdFindAsk
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
        With Selection.Find
            .Text = " ^t"
            .Replacement.Text = " "
            .Forward = True
            .Wrap = wdFindAsk
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
        With Selection.Find
            .Text = "^l"
            .Replacement.Text = "^p"
            .Forward = True
            .Wrap = wdFindAsk
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
        With Selection.Find
            .Text = "  "
            .Replacement.Text = " "
            .Forward = True
            .Wrap = wdFindAsk
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
        With Selection.Find
            .Text = "^p^t"
            .Replacement.Text = "^p"
            .Forward = True
            .Wrap = wdFindAsk
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
    End Sub
    
  • Delete Unused Styles

    I don’t recall where I found this on the interwebs. It seems to work well. If anyone finds the original source, please comment and I’ll give the credit where credit is due!

    Sub DeleteUnusedStyles()
        Dim oStyle As Style
       
        On Error GoTo ErrorHandler
       
        Application.ScreenUpdating = False ' try to speed it up
     
        For Each oStyle In ActiveDocument.Styles
            'Only check out non-built-in styles
            If oStyle.BuiltIn = False Then
                With ActiveDocument.Content.Find
                    .ClearFormatting
                    .Style = oStyle.NameLocal
                    .Execute FindText:="", Format:=True
                    If .Found = False Then oStyle.Delete
                End With
            End If
        Next oStyle
       
    ErrorHandler:
        Application.ScreenUpdating = False
       
    End Sub