Cannot Insert Column with VBA

[atardif]

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 is Code:
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
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

 

[radiant0619]

Hi
Try the following VBA Code

<code>
Sub add_column()
ActiveSheet.Columns("A:A").Select
Selection.Insert shift:=xlRight
End Sub
</code>

Regards
Radiant

 

[Michael M]

OR
If you are using the active sheet

Sub add_column()
Columns("A:A").Insert shift:=xlRight
End Sub

Try and avoid the use of Select.Selection

 

[atardif]

Hi Radiant, Michael

Thanks for your efforts, but no luck unfortunately.

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.

 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

Thanks again
Alex

 

[Michael M]

Worksheets("Data").Columns("A:A").Insert shift:=xlToRight

 

[atardif]

Hi Michael,

Didn't work unfortunately. The top row shifts right, and then a random cell in column A pulls through. In this case it was A4.

I'm at a loss!

 

[radiant0619]

attach the sample workbook

regards

radiant

 

[atardif]

Hi Radiant

Sorry, I have no idea how to? I can't see an attachment button

Thanks
Alex