Insert columns in between a range of columns in reverse...?

[B-radK]

Hello Team,

I have a sheet with 3 months' worth of information (starting with the last day of the previous month). The dates run across row 1. The column count can vary, depending on the months displayed. I.e. April | May | June = a total of 91, whereas May | June | July would have a total of 92. Obviously if Feb was included, it would be less. See pic below.

I need to insert a column, every second column. I can do this running from left to right with the code below.

Dim i As Long

For i = 5 To 200 Step 2
    Columns(i).Insert
Next

However, I thought it would be much 'cleaner' if I started from right to left. Because, if I started from left to right, I would have to change the code every time I ran over a new month and the total number of days were greater/less.

I'm fairly new to vba and I'm trudging my way through an online vba course (Leila Gharani - other recommendations would be helpful too, thanks) and I gave this one a shot, but no joy.
I would need the last blank column to be column E.

Dim i As Long

Dim LastCol As Range

Set LastCol = Range("A" & Columns.Count).End(xlToLeft).Columns

For i = LastCol To 5 Step -2
    Columns(i).Insert
Next

Any ideas on how to run this?

Also, I have this code which would work after I inserted the blank columns and it runs at 0.98 seconds, which I thought was pretty slow for only a few lines of code. Where I run the calculation between the original columns seems to be slow. I was wondering if my code could be simplified (being new to vba, I'm sure it can be).

Sub Insert_Cols_Reverse()

Application.ScreenUpdating = False

'The code for inserting blank columns from right to left will be entered here

'Copy blank cells in Row 1 with cell to the right.

With Range("A1:CV1")
    .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=RC[1]"
    .Value = .Value
End With


'Calculate difference between original columns

 Dim c As Range
 
 For Each c In Range("A1").CurrentRegion
    If c.Value = "" Then
        c.FormulaR1C1 = "=RC[1]-RC[-1]"
        c.PasteSpecial (xlPasteValuesAndNumberFormats)
    End If
 Next c


'Copy and Paste Values of all cells so I can delete the original columns

Cells.copy
Cells.PasteSpecial (xlPasteValuesAndNumberFormats)
Application.CutCopyMode = False
Range("A1").Select


'Delete original columns.

Dim t As Long

For t = 4 To 200 Step 1
    Columns(t).Delete
Next


Application.ScreenUpdating = True

End Sub

Thanks team. I'd appreciate any assistance I can get.

Brad.

 

[B-radK]

Sorry, I forgot to comment out paste special when calculating the difference between the original columns.:

'c.PasteSpecial (xlPasteValuesAndNumberFormats)

 

[Fluff]

To insert the columns try

Sub BradK()
   Dim i As Long
   
   For i = Cells(1, Columns.Count).End(xlToLeft).Column To 5 Step -1
      Columns(i).Insert
   Next i
End Sub

 

[B-radK]

G'day Fluff,

Thanks, works a treat.

I can also send you an All Blacks logo if you wanted to change yours??

Cheers,
Brad.

 

[Fluff]

You're welcome & thanks for the feedback.

Think I'll stick with a rose, rather than a fern.

 

[B-radK]

G'day again Fluff,

OK re the rose and not a fern. My wife would have a Wallabies logo...

When I insert your code and run it in conjunction with the rest of the code I wrote, the time it takes to run is 10 seconds.

Do you have any ideas on how to run that a bit quicker? Whole sub below:

The file I'm working with has about 100 odd columns and about 120 rows before the sub is run.

Thanks,
Brad.

Sub Insert_Cols_Reverse()


Application.ScreenUpdating = False


'Insert blank column in between existing columns

   Dim i As Long
   
   For i = Cells(1, Columns.Count).End(xlToLeft).Column To 5 Step -1
      Columns(i).Insert
   Next i



'Copy blank cells in Row 1 with cell to the right.

    With Range("A1:GZ1")
        .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=RC[1]"
        .Value = .Value
    End With


'Calculate difference between original columns

 Dim c As Range
 
    For Each c In Range("A1").CurrentRegion
        If c.Value = "" Then
            c.FormulaR1C1 = "=RC[1]-RC[-1]"
        End If
    Next c



'Copy and Paste Values of all cells so I can delete the original columns

    Cells.copy
    Cells.PasteSpecial (xlPasteValuesAndNumberFormats)
    Application.CutCopyMode = False
    Range("A1").Select


'Delete original columns.

    Dim t As Long
    
    For t = 4 To 300 Step 1
        Columns(t).Delete
    Next


'Delete Rental Column
    Range("C:C").EntireColumn.Delete
    

Application.ScreenUpdating = True


End Sub

 

[Fluff]

How about

Sub Insert_Cols_Reverse()
   Dim i As Long, UsdRws As Long
   
   Application.ScreenUpdating = False

   UsdRws = Range("A" & Rows.Count).End(xlUp).Row
'Insert blank column in between existing columns
   For i = Cells(1, Columns.Count).End(xlToLeft).Column To 5 Step -1
      Columns(i).Insert
      With Cells(2, i).Resize(UsdRws - 1)
         .FormulaR1C1 = "=RC[1]-RC[-1]"
         .Value = .Value
      End With
   Next i
   
'Copy blank cells in Row 1 with cell to the right.
    With Range("A1:GZ1")
        .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=RC[1]"
        .Value = .Value
    End With
'Delete original columns.

    
    For i = 4 To 300 Step 1
        Columns(i).Delete
    Next


'Delete Rental Column
    Range("C:C").EntireColumn.Delete
    

Application.ScreenUpdating = True

End Sub

 

[B-radK]

G'day Fluff,

Slightly faster at 0.7 seconds...! That's well over 1000%...!

Really happy with your help Fluff, very much appreciated.

?

Cheers,
Brad.

 

[Fluff]

Glad to help & thanks for the feedback.

 

[B-radK]

Hi Fluff,

One last bit of help please?

Now that I have the data required. I need to copy certain cells to another worksheet. I know how to copy one cell to another worksheet based on criteria, but not multiple cells, based on a specific cell.

The next step is to loop through all of the rows and find a value which does not equal zero, copy that cell, the header cell above and the cells in Column A and B. Then repeat.

Here is the before and what I would like it to look like afterwards, from sheet 1 to sheet 2.

Sheet 1 (result of previous posts)

Sheet 2 (The end result I'm after)

Thanks,
Brad.