Solved

Microsoft Excel - Loop or Macro

Posted on 2013-05-17
9
329 Views
Last Modified: 2013-05-17
I have 250 companies on an excel spreadsheet listed accross on a row. My companies are named Co A, Co B and so on. How do I insert two blank columns before each company. I think this can be done with a macro or a Loop. Below is how the companies are currently listed in each column and How I need them.


Current                              
Co A      Co B      Co C                  
                              
Need                              
Blank      Blank      Co A      Blank      Blank      Co B
0
Comment
Question by:Conernesto
  • 4
  • 3
  • 2
9 Comments
 
LVL 3

Expert Comment

by:gnazareth
ID: 39175232
Try this

Sub InsertBlankColumns()
    Set cell = Cells(1, 1)
    
    While cell.Value <> ""
        cell.EntireColumn.Insert Shift:=xlRight
        cell.EntireColumn.Insert Shift:=xlRight
        Set cell = cell.Offset(0, 1)
    Wend
End Sub

Open in new window

0
 

Author Comment

by:Conernesto
ID: 39175254
I have not done this before. How do I/where do I enter this?
0
 
LVL 33

Expert Comment

by:Norie
ID: 39175264
Try this, change the start row and no of columns as required.
Option Explicit

Sub InsertColumns()
Dim rng As Range
Dim HeaderRow As Long
Dim NoColumns As Long

    HeaderRow = 1
    NoColumns = 3


    Set rng = Range("A" & HeaderRow)

    While rng.Value <> ""
        If rng.Value <> "" Then
            rng.Resize(, NoColumns).EntireColumn.Insert xlShiftToRight
        End If

        Set rng = rng.Offset(, 1)
    Wend
    
End Sub

Open in new window

0
PRTG Network Monitor: Intuitive Network Monitoring

Network Monitoring is essential to ensure that computer systems and network devices are running. Use PRTG to monitor LANs, servers, websites, applications and devices, bandwidth, virtual environments, remote systems, IoT, and many more. PRTG is easy to set up & use.

 
LVL 3

Expert Comment

by:gnazareth
ID: 39175267
Make sure your spreadsheet is open
Press Alt + F11
Right click on "Microsoft Excel Objects" -> Insert -> Module
Paste in the code
Sub InsertBlankColumns()
    Set cell = Cells(1, 1)
    
    While cell.Value <> ""
        cell.EntireColumn.Insert Shift:=xlRight
        cell.EntireColumn.Insert Shift:=xlRight
        Set cell = cell.Offset(0, 1)
    Wend
End Sub

Open in new window


Press F5 to run
0
 

Author Comment

by:Conernesto
ID: 39175271
OK. It worked.
0
 

Author Comment

by:Conernesto
ID: 39175363
For the columns inserted can a name for each column be inserted?
I want the first blank column Named "I O" and the second blank column "CmbGrp"

conernesto
0
 
LVL 33

Expert Comment

by:Norie
ID: 39175376
This will add the headers for the new columns.
Option Explicit
Sub InsertColumns()
Dim rng As Range
Dim HeaderRow As Long
Dim NoColumns As Long

    HeaderRow = 1
    NoColumns = 2


    Set rng = Range("A" & HeaderRow)

    While rng.Value <> ""
        If rng.Value <> "" Then
            rng.Resize(, NoColumns).EntireColumn.Insert xlShiftToRight
            rng.Offset(, -2).Resize(, 2).Value = Array("I O", "CmbGrp")
        End If

        Set rng = rng.Offset(, 1)
    Wend
    
End Sub

Open in new window

0
 

Author Comment

by:Conernesto
ID: 39175409
When I run the code to insert the two columns and label the two columns, I get a compile error "ambigous name detected:InsertColumns"

Below is the full code that I have:

Option Explicit

Sub InsertColumns()
Dim rng As Range
Dim HeaderRow As Long
Dim NoColumns As Long

    HeaderRow = 1
    NoColumns = 2


    Set rng = Range("A" & HeaderRow)

    While rng.Value <> ""
        If rng.Value <> "" Then
            rng.Resize(, NoColumns).EntireColumn.Insert xlShiftToRight
        End If

        Set rng = rng.Offset(0, 1)
    Wend
   
End Sub

Option Explicit
Sub InsertColumns()
Dim rng As Range
Dim HeaderRow As Long
Dim NoColumns As Long

    HeaderRow = 1
    NoColumns = 2


    Set rng = Range("A" & HeaderRow)

    While rng.Value <> ""
        If rng.Value <> "" Then
            rng.Resize(, NoColumns).EntireColumn.Insert xlShiftToRight
            rng.Offset(, -2).Resize(, 2).Value = Array("I O", "CmbGrp")
        End If

        Set rng = rng.Offset(, 1)
    Wend
   
End Sub
0
 
LVL 33

Accepted Solution

by:
Norie earned 500 total points
ID: 39175424
That code would replace the previous code.
0

Featured Post

Best Practices: Disaster Recovery Testing

Besides backup, any IT division should have a disaster recovery plan. You will find a few tips below relating to the development of such a plan and to what issues one should pay special attention in the course of backup planning.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

INDEX and MATCH can be used to great effect to replace HLOOKUP and VLOOKUP as it does not have the limitation of needing the data to be sorted so that the reference value is in the first column or row. It also has the ability to perform a bi-directi…
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

803 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question