Please show me how to automatically add a blank column before each table

Hi everybody,

I have a task which needs automation with use of macro and I have written code to do it; however, my code could not do the task successfully. Therefore, I need your help now.

I attached a sample file, including 3 sheets: “start_1”, “start_2” and “result”. “start_1” and “start_2” are identical. I need to format tables in these two sheets “start” so that they look like exactly the “result” sheet.

In detail, here are tasks which need automating:
- Add 1 blank row at top (I have done it)
- Freeze title rows (I have done it)
- This is what I could not do: Add 1 blank column before each table. The added column must have no fill color and no border at all. (Each table here is identified by merged cells in the top title row)
- Also please show me how to determine the last column with data and the last row with data so that the blank outer space is hidden.

Thank you very much for your help.

Below is my code (in ThisWorkbook module):

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim bScrUpdate As Boolean
Dim ws As Worksheet
Dim rng As Range

Application.EnableCancelKey = xlDisabled 'disable ESC key
bScrUpdate = Application.ScreenUpdating
If bScrUpdate = True Then Application.ScreenUpdating = False
Application.DisplayAlerts = False

For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "result" Then
        ws.Select
        Rows("1:1").Insert Shift:=xlDown
        
        Range("A4").Select
        ActiveWindow.FreezePanes = True
        
        For Each rng In Rows("2:2").Cells
            If rng.MergeCells Then
                rng.MergeArea.Cells(1, 1).Select
                Selection.Offset(-1, 1).EntireColumn.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
            End If
        Next rng
    End If
Next ws

Application.DisplayAlerts = True
If Not Application.ScreenUpdating = bScrUpdate _
    Then Application.ScreenUpdating = bScrUpdate
Application.EnableCancelKey = xlInterrupt 'enable ESC key
End Sub

Hi vijnanamatrata!

Please avoid using Cross-Post or provide us the link, so that we dont have to work on a solved (if already) query..

http://chandoo.org/forums/topic/plea...ore-each-table

The problem your have, is you work with merged cells.

to add an column A you have to choose an NON merged cell e.g. A2 and add the column.

 Range("A2").EntireColumn.Insert

This code you can implement in your own code.