Wrox Programmer Forums
Excel VBA Discuss using VBA for Excel programming.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Excel VBA section of the Wrox Programmer to Programmer discussions. This is a community of software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
Old December 2nd, 2005, 12:29 PM
Authorized User
Join Date: Nov 2005
Posts: 16
Thanks: 0
Thanked 1 Time in 1 Post
Send a message via Yahoo to tonyrosen
Default Tab Order Screwy

Okay, first I used this code to "resize" my merged cells:


Sub AutoFitMergedCells(Target As Range)
     'AutoFits a merged cell range, even though it is technically impossible
    Dim MergedWidth As Double, NewHeight As Double, ReqdHeight As Double
    Dim cel As Range, celTemp As Range, col As Range, colCopy As Range, rg As Range, rw As Range
    Dim Mergers As New Collection
    Dim i As Long, nMerge As Long, nRow As Long
    Set rg = Target.Cells(1, 1)
    If Not rg.MergeCells Then Exit Sub
    Application.ScreenUpdating = False
     'Identify all the merged ranges in this row
    nRow = rg.Row
    With Target.Parent 'The worksheet containing the range Target
        For i = 1 To 256
            If .Cells(nRow, i).MergeCells And .Cells(nRow, i).WrapText Then
                nMerge = nMerge + 1
                Mergers.Add Item:=.Cells(nRow, i).MergeArea
                i = i + .Cells(nRow, i).MergeArea.Columns.Count - 1
            End If
        Set colCopy = .Columns(256) '.Insert 'Insert an empty column
        Set celTemp = colCopy.Cells(nRow, 1)
    End With
    For i = 1 To nMerge 'Loop through all the merged areas on this row
        Set rg = Mergers(i)
        With rg
            MergedWidth = 0
            Set cel = .Cells(1, 1)
            For Each col In .Columns
                MergedWidth = col.Width + MergedWidth 'Measured in points
            Next col

            .MergeCells = False
            colCopy.ColumnWidth = 0.1905 * MergedWidth - 0.7139 'Convert from points to "characters"
            celTemp.PasteSpecial xlPasteValues
            celTemp.PasteSpecial xlPasteFormats
            .MergeCells = True


             'For some reason, celTemp.EntireRow.Height changes when .MergeCells=True
            If celTemp.EntireRow.Height > ReqdHeight Then ReqdHeight = celTemp.EntireRow.Height
        End With
    i = Target.Parent.UsedRange.Rows.Count
    Target.RowHeight = Application.Max(ReqdHeight / Target.Rows.Count + 0.49, 12.75) 'Round row height up to 0.5 points, minimum of 12.75 points
    If ReqdHeight >= 409.5 Then MsgBox "Warning! Text is truncated because maximum merged cell height is 409.5 points"
    Application.ScreenUpdating = True
End Sub

Then, we decided to "skip" empty field validation because after using it they believed me when I said it would be annoying. That being said, I had to find something for "tabbing" to the next field - and came across this piece of code in this forum.

In my 'Worksheet_SelectionChange" section I put:


Dim TabOrder As Variant, X As Variant
Dim addr As String
Dim rg As Range, targ As Range
If TabOrderFlag = True Then Exit Sub

TabOrder = Array("Range1", "Range2", "Range3", "Range4", "Range5", "Range8", "Range9", "Range10", "Range11", "Range12", "Range13", "Range14", "Range14a", "Range14b", "Range14c", "Range14d", "Range15") 'List your cell addresses in desired tab order here
For Each X In TabOrder
    If rg Is Nothing Then
        Set rg = Range(X)
        Set rg = Union(rg, Range(X))
    End If

Set targ = Intersect(rg, Target)
If targ Is Nothing Then
    addr = Target.Cells(1, 1).Address(ColumnAbsolute:=False, RowAbsolute:=False)
    X = Application.Match(addr, TabOrder, 0)
    If IsError(X) Then Range(TabOrder(LBound(TabOrder))).Activate
End If

Then, in a module I had to put this:


Public TabOrderFlag As Boolean

Sub TabOrderMode()
    TabOrderFlag = Not TabOrderFlag
End Sub

Now, my problem. The Auto Size Merged Cells code messes up the tab order. Whenever you place a piece of text in a cell, the Auto Size piece kicks in and then messes up the works.

Any ideas?

Old March 1st, 2006, 07:11 PM
Registered User
Join Date: Mar 2006
Posts: 1
Thanks: 0
Thanked 0 Times in 0 Posts

If you didn't find the solution yet, try this code for autofit merged cells.
I started with the same code as you found on the web and ended with complete redo.
 It is much easier on the worksheet
 it doesn;t incert or delet anything and leaves no trace/garbage anywhere.

Private Sub autoFit_Row_w_Merged_Cells(Target As Range, Optional addHeight As Double = 1)
    ' Autofits merged cells in the row.
    ' Fixes Excel bug in fitting
    ' Does this FAST
    ' created by Shura Krechetov, 2006,
    If ActiveSheet.ProtectContents Then
        MsgBox ("worksheet is protected. Can not do anything")
        Exit Sub
    End If
    'go over all all the merged ranges
    Dim r As Range, c As Range
    Dim ReqdHeight As Double
    ReqdHeight = 0
    Set r = Target.Cells(1, 1).EntireRow
    Dim col As Integer, colMax As Integer
    col = Target.Cells(1, 1).Column
    colMax = col + Target.Columns.Count - 1
    Do While col < colMax
        With r.Cells(1, col)
            If .MergeCells And .WrapText Then
                ' autofit row here

                ' calculate width of current merged area
                Dim mergedWidth As Double, mergedRange As Range
                Set mergedRange = .MergeArea
                mergedWidth = mergedRange.Width ' in points

                'unmerge cells
                .MergeCells = False
                'save the column width for the future recovery
                Dim tempColWidth As Double
                tempColWidth = .ColumnWidth

                ' make current column as wide as merged area
                ' one would ask why I convert from points (width)
                ' to characters (columnwidth) and back
                ' Apparently measurement in Columnwidth is much less accurate and
                ' I had a lot of problem matchin widthes with columnwidth
                ' Also Width property is applicable to therange and there is no
                ' need to cycle over all cells
                .ColumnWidth = points2char = 0.1905 * p - 0.7139 'Convert from points to "characters"
                ' fit it

                'save height for the moment look for maximum over the row
                If .RowHeight > ReqdHeight Then ReqdHeight = .RowHeight

                'recover current column width
                .ColumnWidth = tempColWidth

                mergedRange.MergeCells = True
                .EntireRow.RowHeight = Application.Max(ReqdHeight / mergedRange.Rows.Count + 0.5, 12.75) + addHeight
                'go to the next cell after merged area
                col = col + mergedRange.Columns.Count
                col = col + 1
            End If
        End With
End Sub

Similar Threads
Thread Thread Starter Forum Replies Last Post
How to disable a tab on a tab control. dbradley VB.NET 6 April 14th, 2011 10:04 AM
how to many textbox jump by tab in order? richie86 ASP.NET 1.0 and 1.1 Basics 3 December 11th, 2005 04:29 PM
Best tab order implementation policy? nerssi Javascript 1 June 26th, 2005 05:05 AM
Using the TAB ORDER with ENTER KEY ? thomaz C# 0 September 10th, 2003 08:10 AM
document node order vs sort node order. ladyslipper98201 XSLT 2 June 5th, 2003 11:06 AM

Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright (c) 2020 John Wiley & Sons, Inc.