Macro to Add Columns in Excel [Closed]

Report
-
 aby -
Hello,
I have a spreadsheet to track patient information. It has the potential to grow out to the right based on number of contacts made. I need to write a macro to insert 3 columns after the last column with data in it. Now- I can do that and I have done that. HOWEVER- It always inserts the columns in the exact same cell address. It's not going to the column immediately to the right of the last column with data in it. I need to give people the option to insert multiple columns for multiple records as needed. But the way I have the macro running right now, no matter how many times I run it- it inserts the columns in the same spot and would overwrite anything that was in there. I tried hitting the Ctrl and right arrow to get to the cell after the last bit of data and it still doesn't help. Any ideas?! Is it possible?
Related:

5 replies

Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
790
I am little confused this morning. After the last columns the empty columns are available. why insert?? if it is somewhere in the middle I can understand.
4
Thank you

A few words of thanks would be greatly appreciated. Add comment

CCM 4132 users have said thank you to us this month

please enlight me on this matter with thanks.
Hi expert,

may I be advised on how to write macro program to inserts 3 new columns repeatedly after each existing column's of data using excel macro.

meaning my existing data in columns is A1 ,A2, A3, A4, A5 ,A6, A7, A8, A9, A10 etc.
where A denotes row A.

my desire is as follows: A1 a1a1a1 A2a2a2a2 A3a3a3a3 A4a4a4a4 A5a5a5a5 etc.
where a1a1a1 are 3 new columns auto inserted by macro,likewise for a2a2a2 etc.

please help me to improve my efficiency at work so as to enable me to keep my job,thanks.

appreciate yours kind understanding and reply accordingly with thanks.

rgds,
simon.
4
Thank you

A few words of thanks would be greatly appreciated. Add comment

CCM 4132 users have said thank you to us this month

Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
790
REMEMBER YOU ARE MESSING UP THE DATABASE. SO KEEP THE ORIGINAL FILES SAFELY SOMEWHERE FOR RETRIEVAL

try this macro

Sub test()
Dim j As Integer, k As Integer
j = Range("A1").End(xlToRight).Column
'j is the last column
For k = j To 2 Step -1
Range(Cells(1, k), Cells(1, k + 2)).EntireColumn.Insert
Next k
End Sub
4
Thank you

A few words of thanks would be greatly appreciated. Add comment

CCM 4132 users have said thank you to us this month

Hi Venkat,

thanks for your prompt reply.
i did try to write the macro using your program but during running or compilation stage ,i was stuck in the following line:
Range(Cells(1, k), Cells(1, k + 2)).EntireColumn.Insert

please advise me on how to rectify this problem so as to enable me to run the macro properly to auto insert 3 new columns to after every existing columns that is pre-exist with data in it.

appreciate yours help and reply accordingly with thanks.

rgds,
simon.
Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
790
enter 1 in a1, 2 in B1 , 3 in C1 etc upto 6 in F1
run my macro . it will work.


why do you want to write the macro. why not just copy it into vbeditor of your file.
But your file is different from this type then post a small extract.
are there already any blank columns.
Hi Venkat,

please advise me on the meaning of the following line of your program code:
For k = j To 2 Step -1

appreciate yours kind understanding and reply accordingly with thanks.

rgds,
simon
Sub FormGeneration()
'
' FormGeneration Macro
' To generate the initial form
'
' Keyboard Shortcut: Ctrl+Shift+F
'
ActiveCell.FormulaR1C1 = "TOWN"
Range("B1").Select
ActiveCell.FormulaR1C1 = "TIER"
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("C1").Select
ActiveCell.FormulaR1C1 = "RMU MONTHLY BILLING"
Range("C2").Select
ActiveCell.FormulaR1C1 = "Jul-2012"
Range("C2").Select
Selection.AutoFill Destination:=Range("C2:K2"), Type:=xlFillDefault
Range("C2:K2").Select
Range("C1:K1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("A1:B2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A2:K2").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("C1:K1").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("C1:K1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Selection.Font.Bold = True
Range("A2:K2").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Selection.Font.Bold = True
End Sub

Sub InsertColumn()
'
' InsertColumn Macro
' This inserts columns in RMU APPT.PLAN sheet
'
' Keyboard Shortcut: Ctrl+Shift+I
'
Sheets("RMU APPT.PLAN").Select
Columns("B:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("B:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B3").Select
ActiveCell.FormulaR1C1 = "9"
Range("B3").Select
n1 = Worksheets("RMU APPT.PLAN").Range("A3", Range("A3").End(xlDown)).Count
n2 = n1 + 1
Selection.AutoFill Destination:=Range("B3:B" & n2)
Range("B3:B" & n2).Select


Dim x As Integer, r As Range, r1 As Range, c As Range
Dim dest As Range
Set r = Range(Range("A3"), Range("A3").End(xlDown))
For Each c In r
x = Cells(c.Row, "B").Value
Set dest = Cells(Rows.Count, "C").End(xlUp).Offset(1, 0)

Set r1 = Range(dest, dest.Offset(x - 1, 0))
r1.FormulaArray = c.Value
Next c
Range(Range("C2"), Range("C2").End(xlDown)).Cut Range("C1")

'
' CopyDistrictNames Macro
' Copies the repeated districe names from RMU APPT.PLAN to NEW RMU BILLING PLAN
'
' Keyboard Shortcut: Ctrl+Shift+N
'

Sheets("NEW RMU BILING PLAN").Select
Range("A3").Select
Sheets("RMU APPT.PLAN").Select
ActiveWindow.SmallScroll Down:=162
ActiveWindow.ScrollRow = 187
ActiveWindow.ScrollRow = 188
ActiveWindow.ScrollRow = 191
ActiveWindow.ScrollRow = 195
ActiveWindow.ScrollRow = 198
ActiveWindow.ScrollRow = 202
ActiveWindow.ScrollRow = 204
ActiveWindow.ScrollRow = 205
ActiveWindow.ScrollRow = 208
ActiveWindow.ScrollRow = 211
ActiveWindow.ScrollRow = 213
ActiveWindow.ScrollRow = 215
ActiveWindow.ScrollRow = 216
ActiveWindow.ScrollRow = 217
ActiveWindow.ScrollRow = 219
ActiveWindow.ScrollRow = 220
ActiveWindow.ScrollRow = 223
ActiveWindow.ScrollRow = 224
ActiveWindow.ScrollRow = 225
ActiveWindow.ScrollRow = 226
ActiveWindow.ScrollRow = 228
ActiveWindow.ScrollRow = 230
ActiveWindow.ScrollRow = 232
ActiveWindow.ScrollRow = 234
ActiveWindow.ScrollRow = 238
ActiveWindow.ScrollRow = 241
ActiveWindow.ScrollRow = 245
ActiveWindow.ScrollRow = 249
ActiveWindow.ScrollRow = 251
ActiveWindow.ScrollRow = 255
ActiveWindow.ScrollRow = 259
ActiveWindow.ScrollRow = 262
ActiveWindow.ScrollRow = 263
ActiveWindow.ScrollRow = 264
ActiveWindow.ScrollRow = 268
ActiveWindow.ScrollRow = 271
ActiveWindow.ScrollRow = 275
ActiveWindow.ScrollRow = 278
ActiveWindow.ScrollRow = 281
ActiveWindow.ScrollRow = 285
ActiveWindow.ScrollRow = 289
ActiveWindow.ScrollRow = 293
ActiveWindow.ScrollRow = 297
ActiveWindow.ScrollRow = 301
ActiveWindow.ScrollRow = 304
ActiveWindow.ScrollRow = 306
ActiveWindow.ScrollRow = 309
ActiveWindow.ScrollRow = 310
ActiveWindow.ScrollRow = 313
ActiveWindow.ScrollRow = 316
ActiveWindow.ScrollRow = 318
ActiveWindow.ScrollRow = 322
ActiveWindow.ScrollRow = 326
ActiveWindow.ScrollRow = 331
ActiveWindow.ScrollRow = 337
ActiveWindow.ScrollRow = 343
ActiveWindow.ScrollRow = 350
ActiveWindow.ScrollRow = 358
ActiveWindow.ScrollRow = 364
ActiveWindow.ScrollRow = 372
ActiveWindow.ScrollRow = 380
ActiveWindow.ScrollRow = 386
ActiveWindow.ScrollRow = 390
ActiveWindow.ScrollRow = 396
ActiveWindow.ScrollRow = 401
ActiveWindow.ScrollRow = 407
ActiveWindow.ScrollRow = 413
ActiveWindow.ScrollRow = 418
ActiveWindow.ScrollRow = 422
ActiveWindow.ScrollRow = 428
ActiveWindow.ScrollRow = 434
ActiveWindow.ScrollRow = 440
ActiveWindow.ScrollRow = 445
ActiveWindow.ScrollRow = 451
ActiveWindow.ScrollRow = 456
ActiveWindow.ScrollRow = 461
ActiveWindow.ScrollRow = 468
ActiveWindow.ScrollRow = 473
ActiveWindow.ScrollRow = 478
ActiveWindow.ScrollRow = 485
ActiveWindow.ScrollRow = 489
ActiveWindow.ScrollRow = 493
ActiveWindow.ScrollRow = 498
ActiveWindow.ScrollRow = 503
ActiveWindow.ScrollRow = 511
ActiveWindow.ScrollRow = 515
ActiveWindow.ScrollRow = 520
ActiveWindow.ScrollRow = 525
ActiveWindow.ScrollRow = 531
ActiveWindow.ScrollRow = 538
ActiveWindow.ScrollRow = 544
ActiveWindow.ScrollRow = 549
ActiveWindow.ScrollRow = 554
ActiveWindow.ScrollRow = 558
ActiveWindow.ScrollRow = 562
ActiveWindow.ScrollRow = 566
ActiveWindow.ScrollRow = 569
ActiveWindow.ScrollRow = 570
ActiveWindow.ScrollRow = 571
ActiveWindow.ScrollRow = 574
ActiveWindow.ScrollRow = 575
ActiveWindow.ScrollRow = 578
ActiveWindow.ScrollRow = 579
ActiveWindow.ScrollRow = 580
ActiveWindow.ScrollRow = 584
ActiveWindow.ScrollRow = 587
ActiveWindow.ScrollRow = 590
ActiveWindow.ScrollRow = 592
ActiveWindow.ScrollRow = 595
ActiveWindow.ScrollRow = 599
ActiveWindow.ScrollRow = 603
ActiveWindow.ScrollRow = 607
ActiveWindow.ScrollRow = 612
ActiveWindow.ScrollRow = 616
ActiveWindow.ScrollRow = 620
ActiveWindow.ScrollRow = 624
ActiveWindow.ScrollRow = 626
ActiveWindow.ScrollRow = 629
ActiveWindow.ScrollRow = 633
ActiveWindow.ScrollRow = 635
ActiveWindow.ScrollRow = 639
ActiveWindow.ScrollRow = 642
ActiveWindow.ScrollRow = 645
ActiveWindow.ScrollRow = 648
ActiveWindow.ScrollRow = 652
ActiveWindow.ScrollRow = 656
ActiveWindow.ScrollRow = 663
ActiveWindow.ScrollRow = 668
ActiveWindow.ScrollRow = 673
ActiveWindow.ScrollRow = 679
ActiveWindow.ScrollRow = 684
ActiveWindow.ScrollRow = 690
ActiveWindow.ScrollRow = 694
ActiveWindow.ScrollRow = 697
ActiveWindow.ScrollRow = 700
ActiveWindow.ScrollRow = 704
ActiveWindow.ScrollRow = 707
ActiveWindow.ScrollRow = 710
ActiveWindow.ScrollRow = 714
ActiveWindow.ScrollRow = 717
ActiveWindow.ScrollRow = 719
ActiveWindow.ScrollRow = 722
ActiveWindow.ScrollRow = 728
ActiveWindow.ScrollRow = 732
ActiveWindow.ScrollRow = 736
ActiveWindow.ScrollRow = 740
ActiveWindow.ScrollRow = 743
ActiveWindow.ScrollRow = 745
ActiveWindow.ScrollRow = 747
ActiveWindow.ScrollRow = 751
ActiveWindow.ScrollRow = 752
ActiveWindow.ScrollRow = 753
ActiveWindow.ScrollRow = 757
ActiveWindow.ScrollRow = 760
ActiveWindow.ScrollRow = 761
ActiveWindow.ScrollRow = 764
ActiveWindow.ScrollRow = 766
ActiveWindow.ScrollRow = 768
ActiveWindow.ScrollRow = 769
ActiveWindow.ScrollRow = 770
ActiveWindow.ScrollRow = 772
ActiveWindow.ScrollRow = 773
ActiveWindow.ScrollRow = 763
ActiveWindow.ScrollRow = 748
ActiveWindow.ScrollRow = 732
ActiveWindow.ScrollRow = 718
ActiveWindow.ScrollRow = 701
ActiveWindow.ScrollRow = 685
ActiveWindow.ScrollRow = 669
ActiveWindow.ScrollRow = 654
ActiveWindow.ScrollRow = 637
ActiveWindow.ScrollRow = 621
ActiveWindow.ScrollRow = 601
ActiveWindow.ScrollRow = 582
ActiveWindow.ScrollRow = 561
ActiveWindow.ScrollRow = 533
ActiveWindow.ScrollRow = 511
ActiveWindow.ScrollRow = 494
ActiveWindow.ScrollRow = 474
ActiveWindow.ScrollRow = 456
ActiveWindow.ScrollRow = 439
ActiveWindow.ScrollRow = 423
ActiveWindow.ScrollRow = 409
ActiveWindow.ScrollRow = 392
ActiveWindow.ScrollRow = 380
ActiveWindow.ScrollRow = 365
ActiveWindow.ScrollRow = 351
ActiveWindow.ScrollRow = 337
ActiveWindow.ScrollRow = 323
ActiveWindow.ScrollRow = 313
ActiveWindow.ScrollRow = 297
ActiveWindow.ScrollRow = 283
ActiveWindow.ScrollRow = 272
ActiveWindow.ScrollRow = 259
ActiveWindow.ScrollRow = 247
ActiveWindow.ScrollRow = 237
ActiveWindow.ScrollRow = 225
ActiveWindow.ScrollRow = 216
ActiveWindow.ScrollRow = 208
ActiveWindow.ScrollRow = 199
ActiveWindow.ScrollRow = 191
ActiveWindow.ScrollRow = 182
ActiveWindow.ScrollRow = 171
ActiveWindow.ScrollRow = 161
ActiveWindow.ScrollRow = 148
ActiveWindow.ScrollRow = 139
ActiveWindow.ScrollRow = 132
ActiveWindow.ScrollRow = 124
ActiveWindow.ScrollRow = 120
ActiveWindow.ScrollRow = 116
ActiveWindow.ScrollRow = 111
ActiveWindow.ScrollRow = 107
ActiveWindow.ScrollRow = 102
ActiveWindow.ScrollRow = 94
ActiveWindow.ScrollRow = 89
ActiveWindow.ScrollRow = 84
ActiveWindow.ScrollRow = 78
ActiveWindow.ScrollRow = 76
ActiveWindow.ScrollRow = 72
ActiveWindow.ScrollRow = 68
ActiveWindow.ScrollRow = 65
ActiveWindow.ScrollRow = 63
ActiveWindow.ScrollRow = 59
ActiveWindow.ScrollRow = 55
ActiveWindow.ScrollRow = 53
ActiveWindow.ScrollRow = 49
ActiveWindow.ScrollRow = 46
ActiveWindow.ScrollRow = 42
ActiveWindow.ScrollRow = 38
ActiveWindow.ScrollRow = 34
ActiveWindow.ScrollRow = 31
ActiveWindow.ScrollRow = 26
ActiveWindow.ScrollRow = 23
ActiveWindow.ScrollRow = 21
ActiveWindow.ScrollRow = 17
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 13
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 1
Application.CutCopyMode = False
Range("C1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Sheets("NEW RMU BILING PLAN").Select
ActiveSheet.Paste
Columns("A:A").ColumnWidth = 16.71
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Rows("3:3").EntireRow.AutoFit
With Selection
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("A:A").EntireColumn.AutoFit
ActiveWindow.SmallScroll Down:=-36
'
' deleteredundantcolumns Macro
' this deletes the redundant columns to clean up the sheet
'
' Keyboard Shortcut: Ctrl+Shift+D
'
Sheets("RMU APPT.PLAN").Select
Columns("B:C").Select
Selection.Delete Shift:=xlToLeft
Sheets("RMU APPT.PLAN").Select
End Sub