Cannot Insert Column with VBA

A

atardif

New Member
Joined
Jul 23, 2011
Messages
4
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
 
Last edited by a moderator:

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Sort by date Sort by votes
Hi
Try the following VBA Code

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

Regards
Radiant
 
Upvote 0
OR
If you are using the active sheet
Code: 
Sub add_column()
Columns("A:A").Insert shift:=xlRight
End Sub
Try and avoid the use of Select.Selection
 
Upvote 0
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.


Code: 
 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
 
Last edited:
Upvote 0
Code: 
Worksheets("Data").Columns("A:A").Insert shift:=xlToRight
 
Upvote 0
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!
 
Upvote 0
You must log in or register to reply here.

Similar threads

O
  • Solved
VBA - floating photo
Replies
3
Views
305
RoryA
RoryA
H
  • Question Question
VBA Attempting to Insert New Rows but Only needing Column A copied
2 3 4
Replies
30
Views
1K
jolivanes
jolivanes
B
  • Question Question
VBA to Insert Column, Lookup to another workbook, return results.
Replies
1
Views
197
dermie_72
D
M
  • Solved
Insert new row with incremental formula
Replies
8
Views
479
Sheik
S
Q
  • Question Question
Macro needed to insert 4 rows in table, copy data from above, copy data from another sheet and paste special (transpose values) to those new rows...re
Replies
1
Views
229
sijpie
sijpie

Forum statistics

Threads
1,223,228
Messages
6,170,876
Members
452,363
Latest member
merico17

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top