VBA Macro to Hide Columns and Insert New Column

[Mr_Peter]

Hi all, I am a bit new to VBA. I want to write a macro where the macro will always hide 2 columns to the right of a reference cell value/column, in this case column "B".

I also want to insert a column between "E" and "F" after the two columns "C" and "D" have been hidden, the new column between "E" and "F" needs to have the same date cell as E3 with the Plan and Actual headers I have.

After that I need the macro to insert a new column after the last used column with a date header that is a week later than the last column header. So in this case column "T" needs to have a date value of 2023/02/18.

So this is what it looks like before the macro above, and here is a picture of what I need the table to look like after:

 

[Mr_Peter]

Hi all, I have figured out inserting a new column after the last used column with a VBA macro, but I am struggling with hiding the 2 columns to the right of reference cell "B3"

Sub Insert_Column()

    Dim ws As Worksheet

    Set ws = ActiveSheet
    Dim rLastCell As Range
    Dim LastCol As Integer

    Set rLastCell = ws.Cells.Find(What:="*", After:=ws.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
    xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)

    LastCol = rLastCell.Column

    ws.Columns(LastCol).Copy
    ws.Columns(LastCol + 1).PasteSpecial xlPasteAllUsingSourceTheme
       
End Sub

This the code I used after finding a solution on stackoverflow, to hide the columns though I am having an issue where the counter only counts up until the 3rd column which is the first hidden column. How would I go about counting from the right to left to find the first hidden column when going right to left, then hiding the 2 columns to the right of that column identified?

Sub Hide_Column()

    Dim ColCounter As Long
    Dim Hide As Long
        
    ColCounter = 1
    Do While ColCounter > 0 And ColCounter < 66536
      If Sheet1.Columns(ColCounter).Hidden = True Then
           MsgBox (ColCounter)
           Exit Do
      End If
      ColCounter = ColCounter + 1
    Loop
    Range(Columns(ColCounter + 1), Columns(ColCounter + 2)).EntireColumn.Hidden = True
          
End Sub

The VBA macro to hide columns needs to always hide the 2 immediate columns to the right of the reference cell "B3", then insert a column between the 2 columns after if that makes sense. In the 1st picture of my first post in this thread, column "C" and "D" will be hidden, then another column will be inserted between "E" and "F" which is how the 2nd picture looks, thank you again!

 

[Mr_Peter]

Hi all, I have managed to find a solution after utilising the services of someone on fiverr. Here is the code for the macro to hide the 2 columns to the right of "B3", then insert a column between the immediate next 2 columns and adding a column at the end of the range with a date header 7 days into the future, hope this helps anyone who comes across a similar problem!

VBA code for macro:

Sub program_macro1()
Dim last_col As Long
Dim actws As Worksheet
Application.ScreenUpdating = False
For i = 1 To ThisWorkbook.Sheets.Count
    Set actws = ThisWorkbook.Sheets(i)
    actws.Activate
    If actws.Name <> "Historical" And actws.Name <> "Historical_GHANA_SA" And actws.Visible = True Then
        last_col = actws.Cells(3, actws.Columns.Count).End(xlToLeft).Column
        For j = 3 To last_col
            If actws.Columns(j).Hidden = False Then
                col_vis = j
                Exit For
            End If
        Next j

        actws.Range(actws.Columns(col_vis), actws.Columns(col_vis + 1)).EntireColumn.Hidden = True
    actws.Columns(col_vis + 3).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
     actws.Cells(2, col_vis + 2).Value = "Planned"
     actws.Cells(2, col_vis + 3).Value = "Actuals"

    actws.Cells(3, col_vis + 2).Copy
    actws.Cells(3, col_vis + 3).PasteSpecial xlPasteValues
    Application.CutCopyMode = False

     last_col = actws.Cells(3, actws.Columns.Count).End(xlToLeft).Column

     actws.Columns(last_col).Copy
     actws.Columns(last_col + 1).Select
     actws.Paste
    Application.CutCopyMode = False
    actws.Cells(1, 1).Select
    actws.Range(actws.Cells(4, last_col + 1), actws.Cells(40000, last_col + 1)).ClearContents

    End If
Next i
Application.ScreenUpdating = True
MsgBox "Process Completed!", vbInformation
End Sub