Link to home
Create AccountLog in
Avatar of Conernesto
ConernestoFlag for United States of America

asked on

Microsoft Excel - Loop or Macro

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
Avatar of gnazareth
gnazareth
Flag of United States of America image

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

Avatar of Conernesto

ASKER

I have not done this before. How do I/where do I enter this?
Avatar of Norie
Norie

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

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
OK. It worked.
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
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

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
ASKER CERTIFIED SOLUTION
Avatar of Norie
Norie

Link to home
membership
Create an account to see this answer
Signing up is free. No credit card required.
Create Account