Cannot Insert Column

Dear All

I would greatly appreciate your help on this, because I am going crazy.

I have a spreadsheet filled with data (no merged cells) and I created a macro to sort the spreadsheet. Everything was working perfectly, until I tried to insert a column using code at the beginning of the macro.

]The code I have used is:

[vba]Columns("A:A").Select
Selection.Insert Shift:=xlToRight [/vba]
When the macro now runs, the first row acts as if a column has been inserted, i.e it shifts to the right, but the remainder of the spreadsheet does not.

I've tried shifting data to a new sheet, creating a new module, inserting another column, nothing works!!! However, if I step-into the macro, after stepping over the code once (where it does as above), when I shift the cursor above the code and step over it again, it inserts the column!

This is driving me to distraction, any thoughts or help would be greatly appreciated!!

Thanks
Alex

Can we see all the code?

I thought it might be useful for you to see the buildup to the code. Also, I am using MO 2011. The code is massive, but this is everything that appears before the insert column code. Basically this macro is sorting out a mass of data into some semblance of order - Sub MainC() is where the error occurs.

I have attached as a txt file


Thanks again
Alex

Alex, Welcome to VBAX forum and for future reference it would have been just as simple to post the code to the forum rather than the .doc file.

[vba]Sub MainA()
'
' ReportingV2 Macro
'
' Keyboard Shortcut: Option+Cmd+t
'THIS MACRO WILL REMOVE ALL TOTALS, CREATE COLUMN HEADINGS, SHIFT MARKET CODES TO LEFT'
'
Worksheets("Data").Activate
Dim x
Set x = Range("A:A")
Cells.Select
Selection.UnMerge
Range("C:C,E:E,G:G,I:M").Select
Range("I1").Activate
Selection.Delete shift:=xlToLeft
Range("B1").Select
Selection.EntireRow.Insert
ActiveCell.FormulaR1C1 = "Room Revenue"
Range("C1").Select
ActiveCell.FormulaR1C1 = "F&B Revenue"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Other Revenue"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Final Revenue"

Do Until IsEmpty(ActiveCell.Value) 'THIS CODE REMOVES TOTALS'
On Error Resume Next
Cells.Find("total", LookAt:=xlPart).Activate
Rows(ActiveCell.Row).Select
Rows(ActiveCell.Row).Delete
Loop
Columns("A:A").Select
Selection.Insert shift:=xlToRight
Range("a1").Select
ActiveCell.FormulaR1C1 = "Market Code"
Range("b1").Select
ActiveCell.FormulaR1C1 = "Hotel"

Do Until IsEmpty(ActiveCell.Value)
On Error GoTo errorhandler1
Cells.Find(What:=("(o)"), after:=ActiveCell, LookAt:=xlPart).Activate
Selection.Cut
ActiveCell.Offset(1, -1).Activate
ActiveSheet.Paste
Loop
starthere1:
Do Until IsEmpty(ActiveCell.Value)
On Error GoTo errorhandler2
Cells.Find(What:=("(a)"), after:=ActiveCell, LookAt:=xlPart).Activate
Selection.Cut
ActiveCell.Offset(1, -1).Activate
ActiveSheet.Paste
Loop
starthere2:
Do Until IsEmpty(ActiveCell.Value)
On Error GoTo errorhandler3
Cells.Find(What:=("(b)"), after:=ActiveCell, LookAt:=xlPart).Activate
Selection.Cut
ActiveCell.Offset(1, -1).Activate
ActiveSheet.Paste
Loop
starthere3:
Do Until IsEmpty(ActiveCell.Value)
On Error GoTo errorhandler4
Cells.Find(What:=("(n)"), after:=ActiveCell, LookAt:=xlPart).Activate
Selection.Cut
ActiveCell.Offset(1, -1).Activate
ActiveSheet.Paste
Loop
starthere4:
Do Until IsEmpty(ActiveCell.Value)
On Error GoTo errorhandler5
Cells.Find(What:=("(c)"), after:=ActiveCell, LookAt:=xlPart).Activate
Selection.Cut
ActiveCell.Offset(1, -1).Activate
ActiveSheet.Paste
Loop
starthere5:
Do Until IsEmpty(ActiveCell.Value)
On Error GoTo ErrorHandler6
Cells.Find(What:=("(l)"), after:=ActiveCell, LookAt:=xlPart).Activate
Selection.Cut
ActiveCell.Offset(1, -1).Activate
ActiveSheet.Paste
Loop
starthere6:
Do Until IsEmpty(ActiveCell.Value)
On Error GoTo ErrorHandler7
Cells.Find(What:=("(p)"), after:=ActiveCell, LookAt:=xlPart).Activate
Selection.Cut
ActiveCell.Offset(1, -1).Activate
ActiveSheet.Paste
Loop
starthere7:
Do Until IsEmpty(ActiveCell.Value)
On Error GoTo ErrorHandler8
Cells.Find(What:=("(g)"), after:=ActiveCell, LookAt:=xlPart).Activate
Selection.Cut
ActiveCell.Offset(1, -1).Activate
ActiveSheet.Paste
Loop
starthere8:
Do Until IsEmpty(ActiveCell.Value)
On Error GoTo ErrorHandler9
Cells.Find(What:=("(m)"), after:=ActiveCell, LookAt:=xlPart).Activate
Selection.Cut
ActiveCell.Offset(1, -1).Activate
ActiveSheet.Paste
Loop
starthere9:
Do Until IsEmpty(ActiveCell.Value)
On Error GoTo ErrorHandler10
Cells.Find(What:=("(q)"), after:=ActiveCell, LookAt:=xlPart).Activate
Selection.Cut
ActiveCell.Offset(1, -1).Activate
ActiveSheet.Paste
Loop
starthere10:
Do Until IsEmpty(ActiveCell.Value)
On Error GoTo ErrorHandler11
Cells.Find(What:=("(i)"), after:=ActiveCell, LookAt:=xlPart).Activate
Selection.Cut
ActiveCell.Offset(1, -1).Activate
ActiveSheet.Paste
Loop
starthere11:
Do Until IsEmpty(ActiveCell.Value)
On Error GoTo ErrorHandler12
Cells.Find(What:=("(u)"), after:=ActiveCell, LookAt:=xlPart).Activate
Selection.Cut
ActiveCell.Offset(1, -1).Activate
ActiveSheet.Paste
Loop
starthere12:
Do Until IsEmpty(ActiveCell.Value)
On Error GoTo ErrorHandler13
Cells.Find(What:=("(k)"), after:=ActiveCell, LookAt:=xlPart).Activate
Selection.Cut
ActiveCell.Offset(1, -1).Activate
ActiveSheet.Paste
Loop
starthere13:
Do Until IsEmpty(ActiveCell.Value)
On Error GoTo ErrorHandler14
Cells.Find(What:=("(w)"), after:=ActiveCell, LookAt:=xlPart).Activate
Selection.Cut
ActiveCell.Offset(1, -1).Activate
ActiveSheet.Paste
Loop
starthere14:
Do Until IsEmpty(ActiveCell.Value)
On Error GoTo ErrorHandler15
Cells.Find(What:=("(j)"), after:=ActiveCell, LookAt:=xlPart).Activate
Selection.Cut
ActiveCell.Offset(1, -1).Activate
ActiveSheet.Paste
Loop
starthere15:
Do Until IsEmpty(ActiveCell.Value)
On Error GoTo ErrorHandler16
Cells.Find(What:=("(v)"), after:=ActiveCell, LookAt:=xlPart).Activate
Selection.Cut
ActiveCell.Offset(1, -1).Activate
ActiveSheet.Paste
Loop
starthere16:
Do Until IsEmpty(ActiveCell.Value)
On Error GoTo ErrorHandler17
Cells.Find(What:=("(t)"), after:=ActiveCell, LookAt:=xlPart).Activate
Selection.Cut
ActiveCell.Offset(1, -1).Activate
ActiveSheet.Paste
Loop
starthere17:
Do Until IsEmpty(ActiveCell.Value)
On Error GoTo ErrorHandler18
Cells.Find(What:=("(f)"), after:=ActiveCell, LookAt:=xlPart).Activate
Selection.Cut
ActiveCell.Offset(1, -1).Activate
ActiveSheet.Paste
Loop
starthere18:
Do Until IsEmpty(ActiveCell.Value)
On Error GoTo ErrorHandler19
Cells.Find(What:=("(d)"), after:=ActiveCell, LookAt:=xlPart).Activate
Selection.Cut
ActiveCell.Offset(1, -1).Activate
ActiveSheet.Paste
Loop
starthere19:
Do Until IsEmpty(ActiveCell.Value)
On Error GoTo errorhandler20
Cells.Find(What:=("(y)"), after:=ActiveCell, LookAt:=xlPart).Activate
Selection.Cut
ActiveCell.Offset(1, -1).Activate
ActiveSheet.Paste
Loop
starthere20:
Do Until IsEmpty(ActiveCell.Value)
On Error GoTo errorhandler21
Cells.Find(What:=("(r)"), after:=ActiveCell, LookAt:=xlPart).Activate
Selection.Cut
ActiveCell.Offset(1, -1).Activate
ActiveSheet.Paste
Loop
starthere21:
Do Until IsEmpty(ActiveCell.Value)
On Error GoTo errorhandler22
Cells.Find(What:=("(w)"), after:=ActiveCell, LookAt:=xlPart).Activate
Selection.Cut
ActiveCell.Offset(1, -1).Activate
ActiveSheet.Paste
Loop
starthere22:

errorhandler1:
Resume starthere1
errorhandler2:
Resume starthere2
errorhandler3:
Resume starthere3
errorhandler4:
Resume starthere4
errorhandler5:
Resume starthere5
ErrorHandler6:
Resume starthere6
ErrorHandler7:
Resume starthere7
ErrorHandler8:
Resume starthere8
ErrorHandler9:
Resume starthere9
ErrorHandler10:
Resume starthere10
ErrorHandler11:
Resume starthere11
ErrorHandler12:
Resume starthere12
ErrorHandler13:
Resume starthere13
ErrorHandler14:
Resume starthere14
ErrorHandler15:
Resume starthere15
ErrorHandler16:
Resume starthere16
ErrorHandler17:
Resume starthere17
ErrorHandler18:
Resume starthere18
ErrorHandler19:
Resume starthere19
errorhandler20:
Resume starthere20
errorhandler21:
Resume starthere21
errorhandler22:
On Error Resume Next
End Sub

Sub MainB()
'THIS MACRO WILL FILL IN BLANKS OF MARKET CODE, AND ARRANGE HOTELS READY FOR PIVOT TABLE'
Worksheets("Data").Activate
Cells(3, 1).Activate
Dim Area As Range, LastRow As Long 'FILLS BLANKS WITH MARKET CODE'
On Error GoTo errorhandler1
LastRow = Cells.Find(What:="*", SearchOrder:=xlRows, _
searchdirection:=xlPrevious, _
LookIn:=xlFormulas).Row
For Each Area In ActiveCell.EntireColumn(1).Resize(LastRow). _
SpecialCells(xlCellTypeBlanks).Areas
Area.Value = Area(1).Offset(-1).Value
Next
starthere1:
errorhandler1:
On Error Resume Next
End Sub

Sub MainC()
'THIS WILL SORT INTO SALESPERSON'
Worksheets("Data").Activate
Columns("A:A").Select
Selection.Insert shift:=xlToRight[/vba]
Without a workbook with some sample data to run the macros all I get is A1 = Market Code & B1 = Hotel when running Sub MainA()

Note also that Sub MainC() is missing an End Sub. To attach a sample workbook, click on Go Advanced then scroll down to Manage Attachments and follow the prompts from there.

Once this happens we'll start to evaluate your code

Without having your source (so I can't test this code) I think this should work.

Note, don't rely on errors as triggers for things.

This code is a LOT shorter and should run a LOT faster as it hardly selects anything.

[vba]
Sub MainA()
'
' ReportingV2 Macro
'
' Keyboard Shortcut: Option+Cmd+t
'THIS MACRO WILL REMOVE ALL TOTALS, CREATE COLUMN HEADINGS, SHIFT MARKET CODES TO LEFT'
'
Dim MyArray() As Variant
Dim X As Long
MyArray = Array("o", "a", "b", "n", "c", "l", "p", "g", "m", "q", "i", "u", "k", "w", "j", "v", "t", "f", "d", "y", "r", "w")
On Error Resume Next
Worksheets("Data").Activate
Cells.UnMerge
Range("C:C,E:E,G:G,I:M").Delete shift:=xlToLeft
Range("B1").EntireRow.Insert
Range("B1").Formula = "Room Revenue"
Range("C1").Formula = "F&B Revenue"
Range("D1").Formula = "Other Revenue"
Range("E1").Formula = "Final Revenue"
Do Until IsEmpty(ActiveCell.Value) 'THIS CODE REMOVES TOTALS'
Cells.Find("total", LookAt:=xlPart).Activate
Rows(ActiveCell.Row).Select
Rows(ActiveCell.Row).Delete
Loop
Columns("A:A").Insert shift:=xlToRight
Range("A1").Formula = "Market Code"
Range("B1").Formula = "Hotel"
For X = LBound(MyArray) To UBound(MyArray)
Do Until IsEmpty(ActiveCell.Value)
Cells.Find(What:=("(" & MyArray(X) & ")"), after:=ActiveCell, LookAt:=xlPart).Activate
Selection.Cut
ActiveCell.Offset(1, -1).Paste
Loop
Next
End Sub

Sub MainB()
'THIS MACRO WILL FILL IN BLANKS OF MARKET CODE, AND ARRANGE HOTELS READY FOR PIVOT TABLE'
On Error Resume Next
Worksheets("Data").Activate
Cells(3, 1).Activate
Dim Area As Range, LastRow As Long 'FILLS BLANKS WITH MARKET CODE'
LastRow = Cells.Find(What:="*", SearchOrder:=xlRows, searchdirection:=xlPrevious, LookIn:=xlFormulas).Row
For Each Area In ActiveCell.EntireColumn(1).Resize(LastRow).SpecialCells(xlCellTypeBlanks).A reas
Area.Value = Area(1).Offset(-1).Value
Next
End Sub

Sub MainC()
'THIS WILL SORT INTO SALESPERSON'
Worksheets("Data").Activate
Columns("A:A").Insert shift:=xlToRight
End Sub
[/vba]

When shifting data to the right by insertion, it will error if data might move off the sheet.

Actually, I would amend the code a little further in regards to macro Sub MainA()
[vba]Sub MainA()
' ReportingV2 Macro
' Keyboard Shortcut: Option+Cmd+t
'THIS MACRO WILL REMOVE ALL TOTALS, CREATE COLUMN HEADINGS, SHIFT MARKET CODES TO LEFT' '
Dim MyArray() As Variant
Dim X As Long
Application.Screenupdating = False
MyArray = Array("o", "a", "b", "n", "c", "l", "p", "g", "m", "q", "i", "u", "k", "w", "j", "v", "t", "f", "d", "y", "r", "w")
On Error Resume Next
Worksheets("Data").Activate
Cells.UnMerge
Range("C:C,E:E,G:G,I:M").Delete shift:=xlToLeft
Range("B1").EntireRow.Insert
Range("B1").Formula = "Room Revenue"
Range("C1").Formula = "F&B Revenue"
Range("D1").Formula = "Other Revenue"
Range("E1").Formula = "Final Revenue"
Do Until IsEmpty(ActiveCell.Value) 'THIS CODE REMOVES TOTALS'
Cells.Find("total", LookAt:=xlPart).Activate
Rows(ActiveCell.Row).Select
Rows(ActiveCell.Row).Delete
Loop
Columns("A:A").Insert shift:=xlToRight
Range("A1").Formula = "Market Code"
Range("B1").Formula = "Hotel" For X = LBound(MyArray) To UBound(MyArray)
Do Until IsEmpty(ActiveCell.Value)
Cells.Find(What:=("(" & MyArray(X) & ")"), after:=ActiveCell, LookAt:=xlPart).Activate Selection.Cut ActiveCell.Offset(1, -1).Paste
Loop Next
Application.Screenupdating = True
End Sub [/vba]

Have we found a solution to this issue?