Jan 252017
 

Conditional formatting is a great tool, but after a spreadsheet has a lot of edits, the number of conditional rules spirals out of control.

To solve this I wrote a short VBA macro, which propagates conditional formatting (and only conditional formatting) from the top-most cell in each column. It’s a simplistic implementation, with the following restrictions:

  • It replicates the formatting column-by-column, copying the conditional formatting from the first (top-most) cell which has some. Make sure that the rules you want propagated are topmost in the list and include that topmost cell before running.
  • Corollary: It doesn’t handle multi-column formatting.

Paste the following code into a new module:

Option Explicit
Option Compare Text
Sub Test(xls As String)
    ' Open the workbook with conditional formatting.
    '   Test wookbookname
    ' in the immediate window
    ' this will merge the conditional formatting on the first worksheet of that book
    Dim wb As Workbook
    Set wb = Workbooks(xls)
    Dim ws As Worksheet
    Set ws = wb.Worksheets(1)
    MergeConditional ws
End Sub
Public Sub MergeConditional(ws As Worksheet)
    On Error GoTo FAIL
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Dim lur As Long
    lur = LastUsedRow(ws)
    Dim luc As Long
    luc = LastUsedCol(ws)
    Dim col As Integer
    Dim row As Long
    For col = 1 To luc
        Dim found As Boolean
        found = False
        Dim source As Range
        For row = 1 To lur
            Set source = ws.Cells(row, col)
            If source.FormatConditions.Count > 0 Then
                found = True
                Exit For
            End If
        Next row
        If found And row < lur Then
            ws.Range(ws.Cells(row + 1, col), ws.Cells(1048576, col)).FormatConditions.Delete
            Dim target As Range
            Set target = ws.Range(ws.Cells(row, col), ws.Cells(lur, col))
            Dim i As Integer
            For i = 1 To source.FormatConditions.Count
                source.FormatConditions(i).ModifyAppliesToRange target
            Next i
        End If ' found
    Next col
FAIL:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Private Function LastUsedCol(ws As Worksheet) As Long
    On Error Resume Next
    LastUsedCol = 1
    LastUsedCol = ws.Cells.Find("*", SearchOrder:=xlByColumns, LookIn:=xlValues, SearchDirection:=xlPrevious).Column
End Function
Private Function LastUsedRow(ws As Worksheet) As Long
    On Error Resume Next
    LastUsedRow = 1
    LastUsedRow = ws.Cells.Find("*", SearchOrder:=xlByRows, LookIn:=xlValues, SearchDirection:=xlPrevious).row
End Function
Jan 312014
 

I knew that LINQPad was good, but hadn’t realised that in addition to LINQ proper, one can write whole programs, complete with generics:

Function Rank(Of T As {IComparable(Of T)})(items As IEnumerable(Of T), item As T) As Integer

   Dim ranked = From i In items
                Order By i
                Select New With {
                   .key = i,
                   .ranking = (From r In items
                               Where r.CompareTo(i) < 0).Count + 1}

   Return (From i In ranked
           Where i.key.CompareTo(item) = 0
           Select i.ranking).Single

End Function
        
Sub Main()
   Dim l As New list(Of Integer) From {9, 1, 3, 8, 4, 6}
   Dim r As Integer = rank(Of Integer)(l, 6)
   console.write("6 is the " & r & "th element of ")
   For Each n As Integer In l.orderby(Function(x) x)
       console.write(n & " ")
   Next
   console.writeline()
End Sub

which correctly prints
6 is the 4th element of
1 3 4 6 8 9

To say that I’m impressed is a vast understatement.

Aug 132012
 
Imports System.Data
' Refer to these DLLs:
'   microsoft.sqlserver.connectioninfo
'   Microsoft.SqlServer.Management.Sdk.Sfc
'   Microsoft.SqlServer.smo
'   Microsoft.SqlServer.sqlenum
Imports Microsoft.SqlServer.Management.Smo
Imports Microsoft.SqlServer.Management.Sdk.Sfc
Imports Microsoft.SqlServer.Management.Common

Module Module1

    Sub Main()
        GetServers()
        Console.ReadLine()
    End Sub

    Private Function GetServers() As List(Of String)

        Dim servers As New List(Of String)
        Dim dt As DataTable = SmoApplication.EnumAvailableSqlServers(False)

        If dt.Rows.Count > 0 Then

            For Each dr As DataRow In dt.Rows

                Dim servername As String = dr("Name")

                If Not servers.Contains(servername) Then ' Only once per server

                    servers.Add(servername)
                    Console.WriteLine(servername)

                    Dim server As New Server(servername)
                    Try
                        ' Enumerate databases 
                        For Each db In server.Databases

                            If Not db.issystemobject Then
                                Console.WriteLine("  " & db.name)

                                ' Enumerate user tables
                                For Each t As Table In db.tables

                                    If Not t.IsSystemObject Then
                                        Console.WriteLine("    " & t.Name)
                                    End If

                                Next

                            End If

                        Next

                    Catch ex As Exception
                        Console.WriteLine("  " & ex.Message)
                        Console.WriteLine("  Maybe the SQL Server Browser Service isn't started on " & servername & "?")
                    End Try
                End If
            Next
        End If

        Return servers

    End Function


End Module

 Posted by at 10:17 pm  Tagged with:
Jan 132012
 

This spreadsheet contains the VBA code to write an Excel range as a clean, formatted HTML page, with optional auto-refresh.
NOTE If you click on the ‘This spreadsheet’ link above and it opens a ZIP file or a set of HTML files, right-click on the link and choose Save As.

Features:

  • Correctly renders all Excel formatting, including conditional formats.
  • Renders embedded charts.
  • Generates an HTML page with tabs identical to those in the Excel file.
  • Creates clean, formatted HTML that validates to HTML 4.01 strict.
  • Optimised stylesheet to ensure minimal page weight.
  • Supports merged cells with ROWSPAN and COLSPAN.
  • Updates the webpage automatically when cells’ values are changed.
  • The webpage automatically refreshes itself at a user-supplied interval.

The result is almost pixel-perfect, compare this Excel screenshot with the HTML page it generated.

14 March 2013. Update, improved lower tab bar to stop over-spilling (thanks to Paul Palmer) and added support for 64-bit Office.

21 August 2014. Many people have asked how to insert an image in the HTML page. It is not possible to get the contents of an embedded Excel image, but it is possible to get an embedded chart. Here’s how to perform this trick:

  1. In the sheet to be published, make sure no cells are selected
  2. Excel Menu->Insert->Chart and choose any chart type. This will insert an empty chart.
  3. Move and size the empty chart as required
  4. Select the chart by clicking its border
  5. Excel Menu->Layout and click the Picture icon
  6. Select an image file (JPG, BMP, etc) and Insert

28 September 2014. Now handles Unicode text correctly.

Dec 232011
 

I though this would be trivial; turns out it’s not.

  • When you copy a formula from the clipboard, relative references are adjusted, so Range(x).Formula=Range(y).Formula doesn’t produce the expected results.
    The correct way is Range(x).Formula=Range(y).FormulaR1C1. Easy once you’ve been there.
  • Copying border formats with Range(x).Borders=Range(y).Borders crashes Excel. You have to copy each individual border, left, right, top, etc.
  • Similarly for fonts, you have to copy the font attributes one by one.
  • Good practice: check that the areas have compatible sizes and don’t overlap.

Nothing inordinately difficult, but time-consuming to get right. Here’s the code:

Option Explicit

' Copy cells without using the clipboard.
'
' Source is a range from which to copy values/formulas/formats.
' Dest is the destination range. Must be either
'     a single cell, the top-left of the target range. The source size (rows x columns) is copied.
'   or
'     a range exactly the same size as source. We throw an error if the shapes don't match.
'
' If 'what' is omitted, copies the values.
' what=CopyFormulas copies the formulas instead of the values.
' what=CopyFormats copies the formats.
' what=CopyFormulas+CopyFormats copies both.
'
' Examples:
'   CopyCells Range("b2:c6"), Range("h10")                                   ' Copies 8 cells (6x2) from B2 to H10
'   CopyCells Range(cells(2,2),cells(6,3)), Range("h10")                     ' Idem
'   CopyCells Range(cells(2,2),cells(6,3)), Range(cells(10,10),cells(14,12)) ' Fails, source is 6x2, dest is 6x3
'   CopyCells Range("b2:c6"), Range("b3")                                    ' Fails, source and dest intersect

Public Const CopyFormulas = 1
Public Const CopyFormats = 2
Public Sub CopyCells(source As Range, dest As Range, Optional what As Long)

    ' Turn off screen updating, wastes (a lot of) time
    Dim updating As Boolean
    updating = Application.ScreenUpdating
    Application.ScreenUpdating = False

    If IsMissing(what) Then
        what = 0
    End If

    Dim r As Long
    Dim c As Long

    ' If destination is not a singe (r,c) top-left cell, ensure that the ranges are the same shape and size
    If dest.Rows.Count > 1 Or dest.Columns.Count > 1 Then

        If dest.Rows.Count <> source.Rows.Count Or _
           dest.Columns.Count <> source.Columns.Count Then

            Err.Raise 1000, "CopyCells", "Destination area " & dest.Rows.Count & "x" & dest.Columns.Count & _
                " is not the same shape as the source area " & source.Rows.Count & "x" & source.Columns.Count

        End If
    End If

    If Not (Intersect(source, dest) Is Nothing) Then
            Err.Raise 1000, "CopyCells", "Source area " & Replace(source.Address, "$", "") & " " & source.Rows.Count & "x" & source.Columns.Count & _
                " intersects destination area " & Replace(dest.Address, "$", "") & " " & dest.Rows.Count & "x" & dest.Columns.Count
    End If

    For r = 1 To source.Rows.Count

        For c = 1 To source.Columns.Count

            If what And CopyFormulas Then
                dest.Cells(r, c).Formula = source.Cells(r, c).FormulaR1C1
            Else
                dest.Cells(r, c).Value = source.Cells(r, c).Value
            End If

            If what And CopyFormats Then

                Dim b As Long
                For b = xlEdgeLeft To xlInsideHorizontal
                    With source.Cells(r, c).Borders(b)
                        dest.Cells(r, c).Borders(b).Weight = .Weight ' You must do this *before* linestyle
                        dest.Cells(r, c).Borders(b).LineStyle = .LineStyle
                        dest.Cells(r, c).Borders(b).ColorIndex = .ColorIndex
                        dest.Cells(r, c).Borders(b).TintAndShade = .TintAndShade
                    End With
                Next
                dest.Cells(r, c).ColumnWidth = source.Cells(r, c).ColumnWidth
                dest.Cells(r, c).Interior.Color = source.Cells(r, c).Interior.Color
                dest.Cells(r, c).Interior.Pattern = source.Cells(r, c).Interior.Pattern
                dest.Cells(r, c).HorizontalAlignment = source.Cells(r, c).HorizontalAlignment
                dest.Cells(r, c).IndentLevel = source.Cells(r, c).IndentLevel
                dest.Cells(r, c).NumberFormat = source.Cells(r, c).NumberFormat
                dest.Cells(r, c).Orientation = source.Cells(r, c).Orientation
                dest.Cells(r, c).RowHeight = source.Cells(r, c).RowHeight
                dest.Cells(r, c).UseStandardHeight = source.Cells(r, c).UseStandardHeight
                dest.Cells(r, c).UseStandardWidth = source.Cells(r, c).UseStandardWidth
                dest.Cells(r, c).VerticalAlignment = source.Cells(r, c).VerticalAlignment
                dest.Cells(r, c).WrapText = source.Cells(r, c).WrapText

                With source.Cells(r, c).Font
                    dest.Cells(r, c).Font.Background = .Background
                    dest.Cells(r, c).Font.Bold = .Bold
                    dest.Cells(r, c).Font.Color = .Color
                    dest.Cells(r, c).Font.ColorIndex = .ColorIndex
                    dest.Cells(r, c).Font.FontStyle = .FontStyle
                    dest.Cells(r, c).Font.Italic = .Italic
                    dest.Cells(r, c).Font.Shadow = .Shadow
                    dest.Cells(r, c).Font.Size = .Size
                    dest.Cells(r, c).Font.Strikethrough = .Strikethrough
                    dest.Cells(r, c).Font.Subscript = .Subscript
                    dest.Cells(r, c).Font.Superscript = .Superscript
                    dest.Cells(r, c).Font.Underline = .Underline
                End With
                On Error GoTo 0
            End If

        Next
    Next

    Application.ScreenUpdating = updating

End Sub

Sub test()
    CopyCells Range("b2:c6"), Range("h10"), CopyFormulas + CopyFormats
End Sub

 

Jan 082011
 

For those who envisage building an Excel RTD server, I have written a tutorial and open-sourced the code on SourceForge.

The following topics are covered:

  • How RTD servers work
  • Architecture
  • Excel, Multithreading and callbacks
  • Providing easy-to-read function names
  • Talking to the GoogleMaps APIs
  • Avoiding Application Domain misery
  • Embedding a GoogleMap page in an Excel Task Pane
  • Creating the Setup project
  • Changing the Excel RTD Throttle Interval
  • Utility functions
  • Building help from the source with Sandcastle

I hope that you will find it useful.

Oct 202010
 

Addin for Microsoft Excel which allows you to perform forward and reverse geocoding, both by address and latitude / longitude, calculate Great Circle Distances using Vincenty’s algorithm, calculate travel distances and durations and verify the results with a Google Maps Task Pane, all inside your comfortable Excel interface.

This is useful for creating GoogleMap applications to find places from a list, like this.

Implements three Excel formulas:

=Geocode(request, location)

Request is the field to return:

  • status The status of the geocode request (Fetching, OK, N matches, etc.)
  • latitude The latitude of ‘location’
  • longitude The longitude of ‘location’
  • and so on: formatted_address, country political,administrative_area_level_1 political, administrative_area_level_2 political, administrative_area_level_3 political, locality political, sublocality political, route, street_number, postal_code, types, location_type, partial_match, point_of_interest, establishment, viewpointne, viewpointsw, airport establishment transit_station, bus_station transit_station, establishment, natural_feature, neighborhood political, postal_town, premise, street_address, subpremise

Location is the name or address of a place or point of interest

=GreatCircleDistance(latitude1, longitude1, latitude2, longitude2)

Calculates the Great Circle Distance using Vincenty’s Formula, with fallback to the Haversine formula when Vincenty’s method doesn’t converge.

=Travel(request, origin, destination, mode)

Calculates the distance or duration to get from origin to destination, according to Google Directions.

Request is the field to return:

  • distance The distance in metres from origin to destination
  • duration The estimated duration from origin to destination

Origin and destination are the names or addresses of the start and finish.

Mode is the mode of transport to use: Driving, Bicycling or Walking

Free download here

Enjoy!

Screenshot, click to enlarge:

May 112010
 

In the process of analysing a client’s existing database, I used Visio’s reverse-engineering tool. It works well, but the resulting diagram was an incomprehensible bowl of spaghetti. Visio does have a “Layout shapes” command, which appears to work by moving shapes with repulsive forces and the result is, not surprisingly, repulsive.

What I wanted was a tool which would unravel the spaghetti, so that I could get a grasp of the relationships, edit and revise them and layout again in an iterative process.
Searching for a solution, I found three layout programs, none of which have a Visio interface:

  1. Microsoft Automatic Graph Layout (MSAGL), formerly known as GLEE The first version, GLEE, is free whereas MSAGL costs between 99 USD and 279 USD depending on where you buy it.
  2. Tom Sawyer Layout is also a graph layout library, the price isn’t disclosed on their website.
  3. Graphviz from AT&T research labs, reputed to have the most sophisticated layout algorithms, is free.

Given that the best quality was to be found in the free library, I made the obvious choice.
It took me over a year and some 11’000 lines of VB to get Visio and Graphviz to co-exist; marrying a Unix-style command-line program with a WYSIWYG interface, both with quirks to numerous to mention, was far more challenging than I initially thought.
The result, unimaginatively called GraphVizio, is available here, I hope you’ll find it useful.

25 May 2011 Version 1.1.5 released. Improvements:

Full support for 64-bit Windows and Visio

No longer makes a Visio document ‘dirty’ when opening

Full support for UTF8. This DOT file:

graph  RootGraph {
  node [width="7.08661417322834", height="0.787401574803148", color="#000000", fillcolor="#FFFFFF", fontname=Calibri, fontsize=24, style=filled, shape=box];
  edge [color="#000000", fillcolor="#FFFFFF"];

  "English: Hello, my name is Maurice\n(and blame Google if the translations are bad)" [pos="283.704566929134,620.932913385827", label="English: Hello, my name is Maurice\n(and blame Google if the translations are bad)"];
  "Russian: Здравствуйте, меня зовут Морис" [pos="283.704566929134,526.932913385827", label="Russian: Здравствуйте, меня зовут Морис"];
  "مرحبا، اسمي موريس : Arabic" [pos="283.704566929134,432.932913385827", label="مرحبا، اسمي موريس : Arabic"];
  "Chinese: 你好,我叫莫里斯" [pos="283.704566929134,338.932913385827", label="Chinese: 你好,我叫莫里斯"];
  "שלום, שמי הוא מוריס : Hebrew" [pos="283.704566929134,244.932913385827", label="שלום, שמי הוא מוריס : Hebrew"];
  "Japanese: こんにちは、私の名前はモーリスです" [pos="283.704566929134,150.932913385826", label="Japanese: こんにちは、私の名前はモーリスです"];
  "Thai: สวัสดีชื่อของฉันคือ Maurice" [pos="283.704566929134,56.9329133858268", label="Thai: สวัสดีชื่อของฉันคือ Maurice"];

  "English: Hello, my name is Maurice\n(and blame Google if the translations are bad)"--"Russian: Здравствуйте, меня зовут Морис";
  "Russian: Здравствуйте, меня зовут Морис"--"مرحبا، اسمي موريس : Arabic";
  "مرحبا، اسمي موريس : Arabic"--"Chinese: 你好,我叫莫里斯";
  "Chinese: 你好,我叫莫里斯"--"שלום, שמי הוא מוריס : Hebrew";
  "שלום, שמי הוא מוריס : Hebrew"--"Japanese: こんにちは、私の名前はモーリスです";
  "Japanese: こんにちは、私の名前はモーリスです"--"Thai: สวัสดีชื่อของฉันคือ Maurice";
}

produces this Visio diagram:

Graphvizio UTF8

Aug 272009
 

Problem: You’re using Visual Studio to write a Browser Helper Object for Internet
Explorer and you want to add some images to the web page being displayed.

Here is an example, taken from my Affine addin. The two images I insert are shown by the arrow:

Affine in action

Finding out how to do this is trickier than expected, so here’s the recipe:

  1. Import the images into the project and create a .RC file which identifies them:

    affinehide.bmp bitmap "affinehide.bmp"
    affinefade.bmp bitmap "affinefade.bmp"

    I called this file images.rc in the images directory in my project.

  2. You’ll need RC.EXE, the resource compiler, which is in the Windows SDK. The
    2008 version for .NET 3.5 is here
  3. In your setup project’s, set the prebuild event to

    "D:Affinerc.exe" /r "d:affineimagesimages.rc"

    I copied RC.exe into my project directory because I sometimes work on a 64-bit box, where Program Files becomes Program Files (X86). Adjust the paths to suit your installation.

  4. Open your project’s .VBPROJ file and insert the three red lines shown:

    <?xml version=”1.0″ encoding="utf-8"?>
    <Project DefaultTargets="Build"
    xmlns="http://schemas.microsoft.com/developer/msbuild/2003"
    ToolsVersion="3.5">
    <PropertyGroup>
    <Win32Resource>imagesimages.res</Win32Resource>
    </PropertyGroup>

    <PropertyGroup>
    <Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>

    Thanks to Wouter van Vugt for this!

  5. The HTML to insert the images is straightforward:

    <img src="res://affine.dll/#2/affinehide.bmp"

    where #2 means that the embedded object is an image
    Assuming this string is stored in the variable "buttonhtml" then the code to insert the button on the page is

    a.insertAdjacentHTML(&#34afterEnd&#34, buttonhtml)

  6. Now for the events. You need an event handler for the DHTML event itself:

    Imports mshtml
    Public Delegate Sub DHTMLEvent(ByVal e As IHTMLEventObj)
    _
    Public Class DHTMLEventHandler
    Public Handler As DHTMLEvent
    Private Document As mshtml.IHTMLDocument
    Public Sub New(ByVal doc As mshtml.IHTMLDocument)
    Me.Document = doc
    End Sub
    _
    Public Sub [Call]()
    Handler(CType(Document.parentWindow.event, mshtml.IHTMLEventObj))
    End Sub
    End Class

    Thanks to Rick Strahl

  7. A handler which the above will call, to actually deal with the event:

    Imports mshtml
    Module BrowserEventHandler_
    Public Sub BrowserEventHandler(ByVal e As mshtml.IHTMLEventObj)
    Try
    If e.type = "click"” AndAlso e.srcElement.tagName = "IMG" Then

  8. and finally tghe code to add in in your DocumentComplete event:

    Dim Handler As DHTMLEventHandler = New DHTMLEventHandler(doc)
    Handler.Handler = AddressOf BrowserEventHandler
    doc.onclick = Handler

Happy coding!

Jul 012009
 

From an early age I have practised defensive programming. On a recent project, I was loading data entered on an intranet site to an SQL Server table. Wary, I used SQL’s ISNUMERIC function to validate the numbers users had entered. It worked fine for a few weeks, until somone entered a comma as a decimal separator. It turns out that ISNUMERIC accepts this, whereas casting doesn’t. Here’s the proof:

isnumeric

Doubtless, MS will try and wriggle out by saying that it depends on how your international settings are made. My contention is that if ISNUMERIC says it is then you should be able to CAST it to a number.

Period. 

(sorry for the weak pun)

 Posted by at 11:56 am  Tagged with: