VBA Insert a blank column after each cell and name it

[Sapron75]

Hi,

I want to insert a blank column after every next cell until the end of range +1, then copy the column header text with an additional text. So when I have column B until F with column names 1 until 5, after inserting the blank columns I will have columns B until K and the header of each new column has the text "B" + "-SYS", so the name is "B-SYS", then "C-SYS" etcetera.

After that I want to add another column after every cell that end with the "-SYS" and name it the text of the cell left from it and add the text "-ChECK", so it would be "B-SYS-CHECK".

After that I want to add formulas for each specific column which I added. I want to use a small table and want to use the VLookup function for retrieving the correct formula. But I don't know how to programm this in VBA that it will look at haeder "B-SYS" and looks this up in the table , then puts in the formula, and so on for the other headers.

Can someone point me in the right direction ?

Thanks

Sapron75

 

[footoo]

After that I want to add formulas for each specific column which I added. I want to use a small table and want to use the VLookup function for retrieving the correct formula. But I don't know how to programm this in VBA that it will look at haeder "B-SYS" and looks this up in the table , then puts in the formula, and so on for the other headers.

Insufficient information - unclear what you want to do.

To insert columns :

Sub InsertCols()
Dim rng As Range, c%
Set rng = [B1:F1]
For c = rng.Count To 1 Step -1
    With rng(c)(1, 2)
        .Resize(, 2).EntireColumn.Insert
        .Offset(0, -2) = Split(.Offset(0,-3).Address, "$")(1) & "-SYS"
        .Offset(0, -1) = .Offset(0, -2) & "-CHECK"
    End With
Next
End Sub

 

[Sapron75]

Insufficient information - unclear what you want to do.

To insert columns :

Sub InsertCols()
Dim rng As Range, c%
Set rng = [B1:F1]
For c = rng.Count To 1 Step -1
    With rng(c)(1, 2)
        .Resize(, 2).EntireColumn.Insert
        .Offset(0, -2) = Split(.Offset(0,-3).Address, "$")(1) & "-SYS"
        .Offset(0, -1) = .Offset(0, -2) & "-CHECK"
    End With
Next
End Sub

Thank you ! This is already a great start. Now I want to have the same formula in the second row all the columns that end with the "-CHECK" . Formula is data in original column is the same as SYS column data, then "OK" otherwise "NOT OK".
In the columns that end with "-SYS" there will be a formula too, except that formula can be anything. Therefor I have made a table so VBA can surch the specific header and puts in the formula what's in that table. Table will be situated in sheet 2 from A1 until C999 and formula will be in the 3rd column.

Is that possible ?

THanks for you help so far !

Sapron75

 

[footoo]

Thank you ! This is already a great start. Now I want to have the same formula in the second row all the columns that end with the "-CHECK" . Formula is data in original column is the same as SYS column data, then "OK" otherwise "NOT OK".
In the columns that end with "-SYS" there will be a formula too, except that formula can be anything. Therefor I have made a table so VBA can surch the specific header and puts in the formula what's in that table. Table will be situated in sheet 2 from A1 until C999 and formula will be in the 3rd column.

Is that possible ?

THanks for you help so far !

Sapron75

Post some sample data of the table on Sheet2.

 

[Sapron75]

Post some sample data of the table on Sheet2.

Hi ,

Attached you'll find the diffent screenshots of the worksheets with the raw data (how I get it), then the helpsheet for the formulas, the infosheets for the VLOOKUP formula and it how it ultimately must look like.



Hopefully you can help.

Thanks

Sapron75

 

[footoo]

I don't understand the purpose of the Helpsheet - why not enter the formulas directly onto the infosheets?
What are the actual formulas on the Helpsheet?

Does this do what you want? :

Sub InsertCols()
Dim rng As Range, c%, rng2 As Range
Set rng = [B1:F1]
For c = rng.Count To 1 Step -1
    With rng(c)(1, 2)
        .Resize(, 2).EntireColumn.Insert
        .Offset(0, -2) = Split(.Offset(0, -3).Address, "$")(1) & "-SYS"
        .Offset(0, -1) = .Offset(0, -2) & "-CHECK"
    End With
Next
Set rng = rng.Resize(, rng.Count + 2).Offset(1)
For c = 3 To rng.Count Step 3
    rng(c).FormulaR1C1 = "=IF(RC[-2]=RC[-1],""OK"",""NOT OK"")"
    Set rng2 = Range(rng(c - 1), Cells(Rows.Count, rng(c - 2).Column).End(3)(1, 2))
    Sheets("Helpsheet").[A:A].Find(rng(c - 1)(0))(1, 3).Copy rng2
Next
End Sub

Instead of the above, could you not use an infosheet Template with all the required columns and formulas?

 

[Sapron75]

Thank you footoo !! It helped a lot.

Now I'm looking for an easy way to delete all columns in de main sheet, let's say is named"Raw data", with a certain colomn name which I've listed in the "Helpsheet" in column "T" . So every column in "Raw data" which has a name that exists in the "Helpsheet" in column "T" should be deleted.

Can you help me with this one too ?

Thanks a lot !!!

Sapron75

 

[footoo]

Dim rng As Range, cel As Range, col As Range
With Sheets("Helpsheet")
    Set rng = .Range("T1:T" & .Cells(Rows.Count, "T").End(3).Row)
End With
For Each cel In rng
    Set col = Sheets("Raw Data").[1:1].Find(cel)
    If Not col Is Nothing Then col.EntireColumn.Delete
Next