January 30, 2006

Table Makers

I made a couple of "Table Maker"s over the weekend.

Copy Selection As HTML Table
You can choose to show Row and Column headers, and also whether to show cells as formulas or text. (Thanks Colo for the suggestion)

Basic Color/Font Formatting and Alignment is retained.

With Headers


Without Headers


Shown As Formulas


It's included with my utilities. Download it here.

Copy Selection As Forum Table
I also made a separate add-in for our JMT Forum. I thought it might be handy if you can't upload a workbook.



I'm not sure how universal it is but I guess it will work with other YaBB forums (fingers crossed, it will depend on what tags are used)

Download it here.  

Posted by andrewe at 23:09

January 22, 2006

Gridlines And Borders

This is probably the easiest way to highlight the active cell and it requires no VBA or even conditional formatting.

Look at this picture,


And this one,


And this one.


See the difference? By changing the borders, the active cell becomes surrounded by color. In fact, if you use double lines or thicker lines, the color becomes even more visible. The best colors to highlight seem to be medium colors such as Teal or Blue, but darker colors also work (don't go for the grays though) and they usually show as "black" when printing anyway.

Nice. But before you start trying this out and changing all of the Borders...

Automatic As Default
This took a while to figure out - The default setting for Gridline colors is "Automatic" (the pale gray lines you see when you open a new workbook) and the default setting for Border is Automatic also where they will show as "black".

While the Borders are in the default setting, you can change the Gridlines color by going to Tools, Options, View at the top menu and the Borders will also change to the same color. Even if you untick the Gridlines checkbox to hide them, the Borders will still show as the new color.

This is a sheet wide change. To do this with VBA is simple enough. (There appears to be an RGB version too though I've not tried it yet, this method uses the same color index as Interior and Font colors)

Sub ChangeGridlineColorSheet()
    On Error Resume Next
    ActiveWindow.GridlineColorIndex = 3 ' change color to suit
End Sub

So for every sheet in a workbook, we can use this...

Sub ChangeGridlineColorBook()
    On Error Resume Next
    Dim ws As Worksheet, tSheet As Worksheet
    Set tSheet = ActiveSheet
    For Each ws In ActiveWorkbook.Worksheets
        ws.Activate
        ActiveWindow.GridlineColorIndex = 3 ' change color to suit
    Next
    tSheet.Select
End Sub

I've even applied this to an application class event at work, running the above subroutine from a Workbook Open event. The advantage is any workbook I open, mine or not, changes the Gridline color to suit. The downside is it takes a little longer to open, lucky the workbooks at my company tend be to rather small. You should give the implications some serious thought before you try it though. (Don't use Change or Selection Change for an application wide class event, this interferes with the ability to paste)

But, how about if the Borders are not set as Automatic? Is there an easy way to change the color of all the Borders and still retain existing line weight and patterns?

Sure. Run this code for a selection.

Sub ChangeBorderColorSelection()
    On Error Resume Next
    Dim c As Range, i As Integer
    If TypeName(Selection) <> "Range" Then Exit Sub
    Application.ScreenUpdating = False
    For Each c In Selection
        With c
            For i = 1 To 8
                If .Borders(i).ColorIndex <> -4142 Then _
                    .Borders(i).ColorIndex = 3
            Next
        End With
    Next
    Application.ScreenUpdating = True
End Sub

You can adapt this code to work with sheets and books, but consider that really big files make take a long time as the code has to run through each and every cell. In my case, just a minute or two per book so no big deal. (Don't forget to save first just in case!)

For Sheets,

Sub ChangeBorderColorSheet()
    On Error Resume Next
    Dim c As Range, tRange As Range, i As Integer
    Application.ScreenUpdating = False
    Set tRange = Selection
    ActiveSheet.UsedRange.Select
    For Each c In Selection
        With c
            For i = 1 To 8
                If .Borders(i).ColorIndex <> -4142 Then _
                    .Borders(i).ColorIndex = 3 ' Change color here
            Next
        End With
    Next
    tRange.Select
    Application.ScreenUpdating = True
End Sub


And for books,

Sub ChangeBorderColorBook()
    On Error Resume Next
    Dim ws As Worksheet, tSheet As Worksheet
    Dim c As Range, tRange As Range, i As Integer
    Set tSheet = ActiveSheet
    Application.ScreenUpdating = False
    For Each ws In ActiveWorkbook.Worksheets
        ws.Activate
        Set tRange = Selection
        ws.UsedRange.Select
        For Each c In Selection
            With c
                For i = 1 To 8
                    If .Borders(i).ColorIndex <> -4142 Then _
                        .Borders(i).ColorIndex = 3 ' Change color here
                Next
            End With
            Next
        tRange.Select
    Next
    Application.ScreenUpdating = True
    tSheet.Select
End Sub

And each and every book in a folder? Well that can be done too. But it's time to watch the Sunday night movie ;-)

Sometime later: Ah, the movie is boring. Use this code to get the color index (some colors are repeated)

Sub ShowColorIndex()
    On Error Resume Next
    Workbooks.Add
    Do While ActiveCell.Row < 57
        With ActiveCell
            .Interior.ColorIndex = .Row
            .Offset(, 1) = .Row
            .Offset(1).Select
        End With
    Loop
    Cells(1, 1).Select
End Sub

Night!

Update: I did some further experimenting...

My color "suggestions" are as follows,

Teal (Color Index 14) for Workbooks that don't get printed, the "red" lines show up rather well depending on your cell color.

In the case your Borders are normally "black", Dark Blue (Color Index 11) for Workbooks that do get printed (very close to black depending on the ink used, whether you use black/white or color), Dark Teal isn't too bad either, (Color Index 49)  
Posted by andrewe at 21:16

January 19, 2006

More fun with Autoshapes

Here are some more things to do with Autoshapes.

The code used is designed to use with a group of selected shapes. You can select more than one shape by keeping the Ctrl key pushed or using Select Objects from the Drawing Toolbar to drag around them.

Center Align Shapes
You can do this manually by using Align Center and Align Middle from Align or Distribute on the Draw Menu (also to be found on the Drawing toolbar). But I found this way to be a little more convenient.

Note the selected shapes will become transparent. This is so they are all visible when centered and not hidden behind each other. (Optionally you can add an extra shape behind so gridlines etc cannot be seen in the background)

Let's say we have a circle, a square and some lines...



Sub CentralAlignment()
    On Error Resume Next
    Dim cObject As Object
    With Selection.ShapeRange
        .Align msoAlignCenters, False
        .Align msoAlignMiddles, False
        .Fill.Visible = msoFalse
    .Group.Select
    End With
    ' This part adds a shape at the back. Remove if not required.
    '************************************************************
    Set cObject = Selection
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, cObject.Left, cObject.Top, _
                cObject.Width, cObject.Height).Select
    Selection.ShapeRange.Line.Visible = msoFalse
    Selection.ShapeRange.ZOrder msoSendToBack
    ActiveSheet.Shapes.Range(Array(cObject.Name, Selection.Name)).Select
    '************************************************************
End Sub

The shapes themselves,


With a background.


Once aligned you can change formatting or group as you like.

Concentric Shapes
This should be used with a selection of shapes that are the same size and type. As the outer shapes get progressively larger, make sure there is enough room on the spreadsheet. Move the shapes away from the sides if necessary.

Here's a group of circles...



Sub ConcentricShapes()
    On Error Resume Next
    Dim cObject As Object, i As Long
    For Each cObject In Selection
        With cObject
            .Width = Selection(1).Width + (Selection(1).Width * 0.2 * i) ' adjust 0.2 for spacing
            .Height = Selection(1).Height + (Selection(1).Height * 0.2 * i) ' adjust 0.2 for spacing
            .Left = Selection(1).Left + (Selection(1).Width / 2) - (cObject.Width / 2)
            .Top = Selection(1).Top + (Selection(1).Height / 2) - (cObject.Height / 2)
        End With
        i = i + 1
    Next
    For i = Selection.Count To 1 Step -1
        Selection(i).ShapeRange.ZOrder msoBringToFront
    Next
    Selection.ShapeRange.Group.Select
End Sub

Here's how they turn out.



You are getting sleepy...



Who said squares have to be square...?



Oh, Behave!



Have fun ;-)  
Posted by andrewe at 21:26

January 15, 2006

Shaken, Not Stirred

Psst, ever want to send a secret message? Here's a half fun - half serious way to do it.

Here's a pic of my Encoder - Decoder. Don't worry, it doesn't self-destruct :-)



Note there are two modes - you use the Encoder - Decoder by itself, or write to and from cells by selecting "Use Cells". Just keep in mind never to encode or decode a message more than once or it will become gibberish.

The algorithm to encode and decode is quite straightforward, it uses a set of very simple techniques that combined make the code just a little harder to decipher.

I've also included a few options to remove some obvious giveaways, plus a Copy button to insert text into the clipboard and Paste button to insert text into selected cells. Double click the picture of "James" to escape quickly ;-)

Download it here.  
Posted by andrewe at 20:40

January 09, 2006

Day and Date Calculator

Here's something I was playing with over the break. (Thanks to my trusty tester Remco :-))

Day and Date Calculator
You can subtract dates. (The difference between the 2 dates is shown under the "Years, Month, Day" and "Weeks, Day" labels which adjust automatically. Note: The Upper Date must be higher than the Lower Date)



Or calculate dates. (Enter either positive or negative numbers in the textboxes where applicable. The "Calculated Date" label also updates automatically)



Pre-1900 Dates
Notice the lower date from the first image that is shown is Year 100. Dates from Year 100 January 1 until Year 9999 November 30 can be used for both Subtract Dates and Calculate Dates.

Here's a link to download from.  
Posted by andrewe at 17:55