Dynamically insert column based on list?

Question

If I have a list on a separate worksheet, is there way to update (i.e. insert/remove columns) the another worksheet dynamically based on this list? 

For example, Sheet1 contains:

Programs
.NET
AJAX
C#
CICS TSO
CSS
DOS Script
EntireX
FoxPro
JavaScript
JQuery

Sheet 2 contains:

Answer 1

Try this macro:

Sub TestMacro()

    Dim rngC As Range

    Dim rngG As Range

    Dim rngH As Range

    Dim rngHs As Range

    Dim Sht1 As Worksheet

    Dim sht2 As Worksheet

    Dim v As Variant

    Dim m As Variant

    Dim strA As String

    Set Sht1 = Worksheets("Sheet1")

    Set sht2 = Worksheets("Sheet2")

    'First, remove unneeded values

    sht2.Rows(1).Copy

    sht2.Rows(2).Insert

    With Intersect(sht2.Rows(2), sht2.Range("A1").CurrentRegion)

        .Cells.UnMerge

        Intersect(.Cells, sht2.UsedRange).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=RC[-1]"

        .Value = .Value

    End With

    sht2.Rows(4).Insert

    With Intersect(sht2.Rows(4), sht2.Range("A1").CurrentRegion.EntireColumn)

        .FormulaR1C1 = "=MATCH(R[-1]C,INDEX(Sheet1!C1:C702,,MATCH(R[-2]C,Sheet1!R[-3],FALSE)),FALSE)"

        .Value = .Value

        If Application.CountIf(.Cells, "#N/A") > 1 Then

            .Cells.SpecialCells(xlCellTypeConstants, 16).EntireColumn.Delete

        End If

    End With

    sht2.Rows(4).Delete

    sht2.Rows(2).Delete

    For Each rngG In Intersect(Sht1.Range("1:1"), Sht1.UsedRange)

        If rngG.Value <> "" Then

            v = Application.Match(rngG.Value, sht2.Range("1:1"), False)

            If Not IsError(v) Then

            For Each rngH In rngG.Offset(1, 0).Resize(Sht1.UsedRange.Rows.Count, 1)

                If rngH.Value <> "" Then

                    strA = sht2.Cells(1, v).MergeArea.Address

                    Set rngHs = sht2.Range(Replace(strA, 1, 2))

                    m = Application.Match(rngH.Value, rngHs, False)

                    If IsError(m) Then

                        'If it needs to be first

                        If rngH.Row - 1 = 1 Then

                            rngHs.Cells(1, 2).EntireColumn.Insert

                            With rngHs.Cells(1, 1).Resize(sht2.UsedRange.Rows.Count)

                                .Offset(0, 1).Value = .Value

                                .ClearContents

                                .Cells(1, 1).Value = rngH.Value

                            End With

                        End If

                        'If it needs to be in the middle

                        If rngH.Row - 1 <= rngHs.Cells.Count Then

                            rngHs.Cells(1, rngH.Row - 1).EntireColumn.Insert

                            rngHs.Cells(1, rngH.Row - 1).Value = rngH.Value

                        End If

                        'If it needs to be as the end

                        If rngH.Row - 1 > rngHs.Cells.Count Then

                            rngHs.Cells(1, rngHs.Cells.Count).EntireColumn.Insert

                            With rngHs.Cells(1, rngHs.Cells.Count).Resize(sht2.UsedRange.Rows.Count)

                                .Offset(0, -1).Value = .Value

                                .ClearContents

                                .Cells(1, 1).Value = rngH.Value

                            End With

                        End If

                     End If

                End If

            Next rngH

            End If

        End If

    Next rngG

End Sub

Answer 2

Ideally, if a new row is inserted in Sheet1, then a new column is inserted in Sheet2 in the same order.  

Sheet 2 would look like this:

I was thinking, rather than inserting the new column on the above table directly, if we can somehow keep a list on a separate worksheet that the user can update without touching the above table? The problem is that some users somehow mess up the formatting whenever they try to insert new columns.   

Lets say the Office Suite List in Sheet 1 is updated to (adding Access, removing InfoPath):

Sheet 2 worksheet should be dynamically updated to:

Answer 3

So, if a header in row 2 does not exist in Sheet1's list, should that column be deleted from Sheet2? And should it only look at columns headers under the superheading of Programs? And if it is in sheet1 but not in sheet2, where should it be added?  A before and after with all the information (like columns K through.... appearing this time) would be helpful.

Answer 4

@Bernie, thanks for the quick response. And, yes, I need to preserve existing worksheet structure since there will be more categories in addition to "programs" like so...

Answer 5

Do you need to preserve existing data / worksheet structure or do you just want to add those headers?

This will add your values to Sheet2, row 2 in the order that they appear on Sheet1:

Sub Test()

    Worksheets("Sheet2").Range("2:2").ClearContents

    Worksheets("Sheet1").Range("A2", Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)).Copy

    Worksheets("Sheet2").Range("A2").PasteSpecial xlPasteValues, Transpose:=True

End Sub