Insert Column in loop for another sheet

[RoseChompooh]

Hi Guys,

I want to insert the column (in loop) for another sheet.
The example below is the code for inserting column in the current sheet only.
However, does anyone know how can I insert the column in Sheet 2 from the code below please ?

Example:

Sub VBAColumn4()

Dim Column As Integer
Columns(2).Select
For Column = 0 To 12
ActiveCell.EntireColumn.Insert
ActiveCell.Offset(0, 4).Select

Next

End Sub

Thank you. ^^

 

[Peter_SSs]

insert the column in Sheet 2

It is not clear whether Sheet2 means the codename, the tab name or the tab position. This is for the tab name.

Test in a copy of your workbook.

Sub Insert_Columns()
  Dim col As Long
 
  With Sheets("Sheet2")
    For col = 38 To 2 Step -3
      .Columns(col).Insert
    Next col
  End With
End Sub

 

[RoseChompooh]

Thank you very much, this is what I look for.
However, If I want it the start insert the column from the particular column, say 6 + Range("B102").Value. How can I apply to this please ?

 

[Peter_SSs]

Can you spell that out in more detail please? Give an example of what might be in B102 and where the columns should be inserted as a result.
Note that my code inserts the columns starting from the right and working to the left as that generally makes the offset between columns simpler.

 

[RoseChompooh]

For example,

1. At the beginning, There are 3 projects ( ProjectA, ProjectB, ProjectC ) in both sheet1 and Sheet 2 :

2. I add project "ProjectD" into sheet1 and I expected that when I click "Insert Project" button, it will automatically insert the column in the sheet 2 for ProjectD.

3. I want it to work the same if I create project5th, 6th .....
That's why I used the sum value in B102 in order to specify the starting point the insert the column.
For example,
To start at column 6+B102


Please help
? ? ? ? ?

 

[Peter_SSs]

OK, that is much clearer, thanks.

Try this in a copy of your workbook. It assumes that there is already at least one project in both sheets (starting at B2 and down in Sheet1 and G2 and across in Sheet2).
If you add 1 or more new project names in column B of Sheet1 and then run this code it should add columns and labels in Sheet2 for the new project(s).

Sub InsertProject()
  Dim vProjects As Variant
  Dim rHeaders As Range, rProj As Range
  Dim i As Long, lastcol As Long, c As Long
  Dim sProj As String, sPrevProj As String
 
  With Sheets("Sheet1")
    vProjects = .Range("B2", .Range("B" & .Rows.Count).End(xlUp)).Value
  End With
  With Sheets("Sheet2")
    lastcol = .Cells(2, .Columns.Count).End(xlToLeft).Column
    For i = 2 To UBound(vProjects)
      sProj = vProjects(i, 1)
      Set rHeaders = .Range("G2", .Cells(2, lastcol))
      Set rProj = rHeaders.Find(What:=sProj, LookAt:=xlWhole, MatchCase:=False)
      If rProj Is Nothing Then
        sPrevProj = vProjects(i - 1, 1)
        For c = lastcol To 7 Step -1
          If .Cells(2, c).Value = sPrevProj Then
            .Columns(c + 1).Insert
            .Cells(2, c + 1).Value = sProj
            lastcol = lastcol + 1
          End If
        Next c
      End If
    Next i
  End With
End Sub

 

[RoseChompooh]

Thank you very much. Sorry to keep asking you again.

What if I change the layout of each project displays in sheet2 to be merge cells from 2 cells instead of displaying one cell for each project.
Also, each project will have the P(Plan) and A(Actual) cell added underneath. (See the picture below).

May I know is it possible to do this please ? Thank for your help.

 

[Peter_SSs]

May I know is it possible to do this please ?

If I have understood correctly, that is easy enough. Just replace this section in the code

        For c = lastcol To 7 Step -2
          If .Cells(2, c).Value = sPrevProj Then
            .Columns(c + 2).Resize(, 2).Insert
            .Range("G2:H3").Copy Destination:=.Cells(2, c + 2)
            .Cells(2, c + 2).Value = sProj
            lastcol = lastcol + 2
          End If
        Next c

 

[RoseChompooh]

It's work!!!!. Thank you very much. You are the best!!!!!! ?

 

[RoseChompooh]

Hi

For example,

1. At the beginning, There are 3 projects ( ProjectA, ProjectB, ProjectC ) in both sheet1 and Sheet 2 :

View attachment 796

2. I add project "ProjectD" into sheet1 and I expected that when I click "Insert Project" button, it will automatically insert the column in the sheet 2 for ProjectD.

View attachment 795
3. I want it to work the same if I create project5th, 6th .....
That's why I used the sum value in B102 in order to specify the starting point the insert the column.
For example,
To start at column 6+B102


Please help
? ? ? ? ?

Sorry one more question for today. I want to auto format the the cell of each person for each month base on criteria :

1. SUM of the value for the whole month > 1 then highlight Red
2. SUM of the value for the whole month < 1 then highlight Yellow

Example :

This is the code I tried, but it's only work for each cell, not sum of the whole month(of each person)

Private Sub CommandButton1_Click()
Dim rg As Range
Dim cond1 As FormatCondition, cond2 As FormatCondition, cond3 As FormatCondition
Set rg = Range("G6:I6", Range("G6:I6").End(xlDown))
 
'clear any existing conditional formatting
rg.FormatConditions.Delete
 
'define the rule for each conditional format
Set cond1 = rg.FormatConditions.Add(xlCellValue, xlGreater, "1")
Set cond2 = rg.FormatConditions.Add(xlCellValue, xlLess, "1")

 
'define the format applied for each conditional format
With cond1
.Interior.Color = vbGreen
.Font.Color = vbWhite
End With
 
With cond2
.Interior.Color = vbRed
.Font.Color = vbWhite
End With