Some Excel VBA Tips

I have no doubt that a serious VBA programmer would laugh at some of the code chunks that follow below, however my objective here is to show that some seriously useful automation can be done effectively by non-programmers using the Excel macro recorder, online research and a little bit of clear thinking.

One of my recent service requests involved working with some data output from the Items Browser in Excel. A structural user wanted to extract the coordinates of all the Pile tops in the project. These coordinates are not stored as ABD DataGroup Properties, but are available in the element ECdata which can be viewed and exported to Excel form the Items Browser. See Extracting Structural Element Coordinates - Steel or Concrete Piles Example for how to do this.

The Excel macro is contained in ABD Excel Macro Examples, open this file and read through the macro in the Visual Basic Editor while reading this article (enable the Excel Developer tab if you have not already done so, Excel Options > Customize Ribbon > tick the Developer box in the tree structure on the right.)

The start point for the exploration was that the coordinates of the piles were in an inconvenient format in the raw output from the Items Browser. The coordinates are output as the text string shown below:

<DPoint3d xyz="35974.5758747578,9808.0275723705,-10000"/>

My first need was to remove the prefix and suffix from each coordinate string, then to separate them out into individual columns for x, y and z.

Easy enough to do manually….. once. Time to delve into some VBA. A mixture of Macro Recording and online searching came up with the solution that I needed. StackOverflow turned out to be a very useful resource for guidance and code snippets.

Having found a way to automate those steps it quickly became clear that a few other things would be needed and some additional reformatting would be necessary to produce a professional looking output. These are presented in the order of the final macro, not the order in which I worked them out!

First, a new worksheet is needed for the reformatted data to be presented on. This needs a tiny sub-routine:

Sub AddPileSchedule()

    Dim wks As Excel.Worksheet

    Set wks = AddWorksheet(ActiveWorkbook, 6)

    wks.Name = "PileSchedule"

End Sub

This sub-routine is called by:

' Add new worksheet for data to be copied into

    Application.Run "AddPileSchedule"

See the note below for crucial information about worksheet names!

Next I want to select and copy specific columns from the raw data output from ABD. My first version used a series of simple range commands that copied data from say column G in the original to column A  in the new spreadsheet. This is limiting, so on StackOverflow I found a routine that could be adapted to search for columns with specified header names (shown highlighted) and insert them into the new worksheet:

Sub ColumnSearch()

Dim c, d, i As Long, hRow As Range, str As Variant, SearchStr As String

Worksheets("PileSchedule").Cells(1).CurrentRegion.offSet(0).Resize(Sheet1.Cells(1).CurrentRegion.Rows.count).ClearContents

    SearchStr = "Catalog Type,Classification | Uniclass,ID | Asset Tag,Section Name,Member Length,Start Point,End Point,GUID"

    ' Note there could be an input box here but the subsequent actions are currnetly dependent upon specific column ranges:

    '   InputBox("Enter your search items separated by a comma.", "Search")

    

    str = Split(SearchStr, ","): i = 1

    Set hRow = Sheet1.Cells(1).CurrentRegion.offSet(0).Resize(Sheet1.Cells(1).CurrentRegion.Columns.count)

    For Each d In hRow

        For Each c In str

              

            If d.Value = c Then

                d.EntireColumn.Copy Destination:=Worksheets("PileSchedule").Cells(1, i)

                i = i + 1

            End If

            

        Next c

    Next d

End Sub

This sub-routine is called by:

' Copy selected columns from sheet 1 to sheet 2

    Application.Run "ColumnSearch"

The next few steps were gathered via the macro recorder.

The columns were placed in the new file in the order in which they were found by the "ColumnSearch" routine. No doubt this routine could be modified to specify the order but as I only wanted to swap a couple of them around I recorded the manual moves and adapted the resulting code. This involves use of column letters, but as I am not looking for a generalized solution that is OK. Note the use of comments to clearly explain what is going on:

' Get columns in the desired order

' Move Member Length from last column and insert at E

    Columns("H:H").Cut

    Columns("E:E").Insert Shift:=xlToRight

   

' Move GUID to end

    Columns("F:F").Cut

    Columns("K:K").Insert

The initial problem of extracting the coordinates comes next (this is post rationalization, I started with these two steps then went back through the whole process adding in the necessary steps).

First remove the prefix and suffix text:

' Remove formatting from Coordinate values

    Cells.Replace What:="<DPoint3d xyz=""", Replacement:="", LookAt:=xlPart, _

        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _

        ReplaceFormat:=False

    Cells.Replace What:="""/>", Replacement:="", LookAt:=xlPart, _

        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _

        ReplaceFormat:=False

Then extract the individual coordinates into separate columns:

' Add Empty Columns after F for Coordinates to be split into

    Columns("G:H").Insert Shift:=xlToRight

' Extract Coordinates to separate columns

    Columns("F:F").Select

    Selection.TextToColumns Destination:=Range("F1"), DataType:=xlDelimited, _

        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _

        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _

        :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True

    Columns("I:I").Select

    Selection.TextToColumns Destination:=Range("I1"), DataType:=xlDelimited, _

        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _

        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _

        :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True

Rename the new column headings;

' Rename Columns

    Range("F1").Select

    ActiveCell.FormulaR1C1 = "Start X"

    Range("G1").Select

    ActiveCell.FormulaR1C1 = "Start Y"

    Range("H1").Select

    ActiveCell.FormulaR1C1 = "Start Z"

    Range("I1").Select

    ActiveCell.FormulaR1C1 = "End X"

    Range("J1").Select

    ActiveCell.FormulaR1C1 = "End Y"

    Range("K1").Select

    ActiveCell.FormulaR1C1 = "End Z"

(There has to be a more efficient way to do this, but for the sake of a few lines of cut and paste is it worthwhile?)

Finally I wanted to apply a border below the column headers:

' Apply Formatting

    Cells.Select

    Selection.Columns.AutoFit

    Rows("1:1").Select

    Selection.Font.Bold = True

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    Selection.Borders(xlEdgeLeft).LineStyle = xlNone

    Selection.Borders(xlEdgeTop).LineStyle = xlNone

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .ColorIndex = 0

        .TintAndShade = 0

        .Weight = xlThin

    End With

    Selection.Borders(xlEdgeRight).LineStyle = xlNone

    Selection.Borders(xlInsideVertical).LineStyle = xlNone

    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

    Range("A1").Select

consistent number formatting to the coordinates:

    Columns("F:K").Select

    Selection.NumberFormat = "0.000"

and add in three blank lines at the top of the worksheet to accommodate a company/project header, these three steps were all picked out with the Macro Recorder:   

' Insert Blank Rows for Company header

    Rows("1:3").Select

    Selection.Insert Shift:=xlDown

Some other useful tips:

When you create a new worksheet (tab) you can rename the tab. This does not change the actual worksheet name. In the Excel object model a Worksheet has two different name properties:

  • Worksheet.Name
  • Worksheet.CodeName

The Name property is read/write and contains the name that appears on the sheet tab. It is user and VBA changeable

The CodeName property is read-only

You can reference a particular sheet as Worksheets("Fred").Range("A1") where Fred is the .Name property or as Sheet1.Range("A1") where Sheet1 is the codename of the worksheet.

From  http://stackoverflow.com/questions/2649844/excel-tab-sheet-names-vs-visual-basic-sheet-names

To test my code (press F8 to debug) without running the whole macro I pasted the chunk that I wanted to test into this Sub and just debugged that sub

Sub Test()

' Insert lines to be tested here and run from Sub Test()

 

End Sub