Anyone have code to properly insert a column when some of th

[Brian]

Anyone have code to properly insert a column when some of the cells are merged?

ie.
- Record which merged cells cross the column(s) to insert. (Perhaps simply record all merged cells on the sheet.)
- Unmerge all affected cells.
- Insert the column(s).
- Re-merge the affected cells, increasing the range of each merge to include the added columns. (I only need the macro to accomodate merges accross columns of a single row.)

This has always annoyed me in Excel 97, but I have yet to take the time to create the above code.

Alternatively, Is there a way to "Left Justify Accorss Section"? ie. I want my text to be able to wrap text, left justify accross several columns. This can be done with merged cells, but becaomes a pain whenever I want to add or a column.

Also, autofit row height does not work properly accross merged cells so I usually add a hidden column of approriate width that is set equal to the merged cells. (A waste of space, but if there is a better way, please let me know.)

WHY I ASK: I have a sheet to tracking tasks. The schedule dates work best as a horizontal table of narrow cells near the top of the page. The Detailed instructions and reference material are long paragraphs that are best in wide cell (thus the merged cells).

Thanks,

Brian

Files can be mailed to BW-NoSPAM1@earthlink.net

Example in html:

Microsoft Excel - HeyBorisSuggestions-BrianWest6.xls______________Running: xl97 : OS = Windows (32-bit) 5.01
(F)ile (E)dit (V)iew (I)nsert (O)ptions (T)ools (D)ata (W)indow (H)elp
B20		=	Add columns for "date of last transaction" (or other status field) and "last price paid" (&/or standard cost). Place the description column after the price column so that it is easier to cut & paste p/n & desc. into the ECO form.
	A	B	C	D	E	F	G	H
1	:alert('=HYPERLINK(%22[%22&SUBSTITUTE(LEFT(CELL(%22filename%22,A1),SEARCH(%22]%22,CELL(%22filename%22,A1))),%22[%22,%22%22,1)&%22index!A%22%20&%20MATCH($A$2,Index!$B:$B,0),%22{%20INDEX%20}%22)')>{ INDEX }	Hey Boris! Suggestion by			Brian West
2	:alert('=IF(NOT(ISERROR(VLOOKUP(VALUE(RIGHT(CELL(%22filename%22,$A$2),LEN(CELL(%22filename%22,$A$2))-SEARCH(%22]%22,CELL(%22filename%22,$A$2),1))),Index_Table,COLUMN(Index!$J$1),0))),VALUE(RIGHT(CELL(%22filename%22,$A$2),LEN(CELL(%2 2filename%22,$A$2))-SEARCH(%22]%22,CELL(%22filename%22,$A$2),1))),RIGHT(CELL(%22filename%22,$A$2),LEN(CELL(%22filename%22,$A$2))-SEARCH(%22]%22,CELL(%22filename%22,$A$2),1)))')>1.02	Automation for CPSXREF to replace manual manipulation:
3	Response:
4	Details:		Original Submission	Hey Boris! Submission	Emails Sent	Rejected	Accepted	Implemented
5			2002-05-01	2002-05-02
6
7		Priority:	Low
8		Resources:	Low; $1000; 8 hour IT; 8 hours Eng
9		Dependencies:	Purchase of xxx.
10			Email To	Email Sent	Response
11		Groups Affected:	Charlie Brown	2002-05-15	Great
12		Notification:	Brian West	2002-05-16	Sucks
13		Implementation by:	Rudolph	2002-05-17	But what if it snows?
14		Approval by:	Santa Clause	2002-05-18
15	1.00	BACKGROUND:
16	:alert('=OFFSET($A16,-1,0)+0.01')>1.01	Blah Blah, Blah
17	2.00	PROBLEM:
18	:alert('=OFFSET($A18,-1,0)+0.01')>2.01	When looking for a part for something, I start by searching CPSXREF to determine if we already have anything suitable. If I find something promising, then I need to open ASK and run LI.100 to determine if we still buy this part and what the price is.
19	3.00	SOLUTION:
20	:alert('=OFFSET($A20,-1,0)+0.01')>3.01	Add columns for "date of last transaction" (or other status field) and "last price paid" (&/or standard cost). Place the description column after the price column so that it is easier to cut & paste p/n & desc. into the ECO form.
1.02

To see the formula in the cells just click on the cells hyperlink

The above image was automatically generated by[HtmlMaker V1.25]
If you want this code, click here and Colo will email the file to you
This code was graciously allowed to be modified: by Ivan F Moala All credit to Colo

[Colo]

Anyone have code to properly insert a column when some of the cells are merged?

ie.
- Record which merged cells cross the column(s) to insert. (Perhaps simply record all merged cells on the sheet.)
- Unmerge all affected cells.
- Insert the column(s).
- Re-merge the affected cells, increasing the range of each merge to include the added columns. (I only need the macro to accomodate merges accross columns of a single row.)

This has always annoyed me in Excel 97, but I have yet to take the time to create the above code.

Hi Brian,

Here is a sample code I made.

Option Explicit

Sub InsertColumns() 'Just sample

    Dim rngSelected As Range, lngCnt As Long, rngArr() As Range, i As Long

    Set rngSelected = Selection

    With rngSelected

        If .Areas(.Areas.Count).Rows.Count <> Rows.Count Then Exit Sub

        For lngCnt = 1 To .Areas.Count - 1

            If .Areas(lngCnt).Columns.Count > 1 Then

                ReDim Preserve rngArr(0 To i)

                Set rngArr(i) = .Areas(lngCnt)

                Debug.Print rngArr(i).Address

                .Areas(lngCnt).MergeCells = False

                i = i + 1

            End If

        Next

        Columns(.Areas(.Areas.Count).Address).Insert Shift:=xlToRight

        For lngCnt = LBound(rngArr) To UBound(rngArr)

            rngArr(lngCnt).Resize(, rngArr(lngCnt).Columns.Count).MergeCells = True

        Next

    End With

    Erase rngArr

End Sub

HTH

[Brian]

Thanks Colo!

I'll give that a try.


Brian

[Colo]

Hi me again. I think, maybe you need to "delete" columns too.

Please copy this into a standard module.
And run Sub AddRightClickMenu(). "MyInsert" and "MyDelete" menu will apper on your Right Click Menu.
If you don't need the menu, please run Sub Reset().

Sub AddRightClickMenu()

    With Application.CommandBars("Column")

        .Reset

        With .Controls.Add _

             (Type:=msoControlButton, temporary:=False)

            .Caption = "MyInsert"

            .OnAction = "InsertColumns"

        End With

        With .Controls.Add _

             (Type:=msoControlButton, temporary:=False)

            .Caption = "MyDelete"

            .OnAction = "DeleteColumns"

        End With

    End With

End Sub



Sub Reset()

    Application.CommandBars("Column").Reset

End Sub



Private Sub InsertColumns()

    Call LoopLine(True)

End Sub



Private Sub DeleteColumns()

    Call LoopLine(False)

End Sub



Private Sub LoopLine(ByVal blnInsorDel As Boolean)

    Dim rngSelected As Range, lngCnt As Long, rngArr() As Range, i As Long

    Set rngSelected = Selection

    With rngSelected

        If .Areas(.Areas.Count).Rows.Count <> Rows.Count Then Exit Sub

        For lngCnt = 1 To .Areas.Count - 1

            If .Areas(lngCnt).Columns.Count > 1 Then

                ReDim Preserve rngArr(0 To i)

                Set rngArr(i) = .Areas(lngCnt)

                Debug.Print rngArr(i).Address

                .Areas(lngCnt).MergeCells = False

                i = i + 1

            End If

        Next

        If blnInsorDel Then

            If .Areas.Count = 1 Then .Insert Shift:=xlToRight: Exit Sub

            Columns(.Areas(.Areas.Count).Address).Insert Shift:=xlToRight

        Else

            If .Areas.Count = 1 Then .Delete Shift:=xlToRight: Exit Sub

            Columns(.Areas(.Areas.Count).Address).Delete Shift:=xlToRight

        End If

        For lngCnt = LBound(rngArr) To UBound(rngArr)

            rngArr(lngCnt).Resize(, rngArr(lngCnt).Columns.Count).MergeCells = True

        Next

    End With

    Set rngSelected = Nothing

    Erase rngArr

End Sub

HTH