Using VBA to searching for specific headers name, and grouping the data of these headers in several rename columns

Question

In a big file that I am punctualy receiving, I am looking to reorganize data in a new sheet of the excel file.

I am thus looking for specific headers names and either renaming them and copying data or doing more complex operations.

In the simpler case, I am only renaming columns. I am looking for a column named "Spec A" and renaming it "Nabou"

For a more conplex case, I am creating a new column by concatenating columns. However, based on wether or not the information is present in other columns, I am adding a specific text, which can change in various cases. For example, I am concatenating a sevaral columns "nup", "nap", and adding "WAGA" for rows with values located below some specific headers, and adding "CIOCOLATO" for the rows with no values located in these same headers.

The two possible results being:

• nup_nap_WAGA_Snip (for the caeses when specific rows have values below)

• nup_nap_CIOCOLATO_Snip (for the cases when rows below specific headers have no values)

For the worst case, in this same file, I am creating new columns, by concatenating these columns, but I am also appending a specific number in some cases.
In oder to know the number that I am incrementing, I need to look on another exel file (another worksheet) to add a specific input in the increment, which should be increment based on specific condition.

For example I would have this result. The "003" is based on the inscpection of the other workbook, which will look on rows below a specific header for the term "Lettuce" and add "003" when "002" is found after "lettuce":

Lettuce003_SDS_FSGTEGT Cake0049_SDEWF_TGEGT Birthday004_FEGGE_GTEG

Here is the example files. For simplicity, I am not adding the second worksheet, in which I woulike to increment an number in the output file based on a comparaison of the a information in the source worksheet and this worksheet :

Here is the source file :

Here is the output file:

Here is my current result...with the macro, whih is far from what I am trying to do

Here is the code :

Option Explicit

Sub Snouba()

    Const q = """"

' get source data table from sheet 1
    With ThisWorkbook.Sheets(1).Cells(1, 1).CurrentRegion
        ' check if data exists

        If .Rows.Count < 2 Or .Columns.Count < 2 Then
            MsgBox "No data table"
            Exit Sub
        End If

        ' retrieve headers name and column numbers dictionary
        Dim headers As Object
        Set headers = CreateObject("Scripting.Dictionary")
        Dim headCell
        For Each headCell In .Rows(1).Cells
            headers(headCell.Value) = headers.Count + 1
        Next

        ' check mandatory headers
        For Each headCell In Array("Nabou", "Wurp", "Scope 1", "Scope 2", "Scope 3”, "Scope 4", "NipandNup")
            If Not headers.Exists(headCell) Then
                MsgBox "Header '" & headCell & "' doesn't exists"
                Exit Sub
            End If

        Next

        Dim data

        ' retrieve table data
        data = .Resize(.Rows.Count - 1).Offset(1).Value
    End With

    ' process each row in table data
    Dim result As Object
    Set result = CreateObject("Scripting.Dictionary")
    Dim i
    For i = 1 To UBound(data, 1)


     Select Case True
            Case _
                data(i, headers("NipandNup")) = "Nip"
                    MsgBox "Empty row"
                    Exit For

            Case _
                  result(result.Count) = "Nip"

            Case Else
                     result(result.Count) = "Nup"

               End Select








        Select Case True
            Case _
                data(i, headers("Nabou")) = "" Or _
                data(i, headers(""Wurp")) = "" Or _
                data(i, headers("NipandNup")) = ""
                    MsgBox "Empty row"
                    Exit For
            Case _
                data(i, headers("Scope 1")) = "" And _
                data(i, headers("Scope 2")) = "" And _
                data(i, headers("Scope 3")) = "" And _
                data(i, headers("Scope 4")) = ""
                    result(result.Count) = _
                        data(i, headers("Nabou")) & _
                        "_Alpha" & _
                        "_" & data(i, headers("Wurp")) & _
                        "_" & data(i, headers("NipandNup"))



           Case Else
                    result(result.Count) = _
                        data(i, headers("Nabou")) & _
                        "_Alphabet" & _
                        "_" & data(i, headers("Wurp")) & _
                        "_" & data(i, headers("NipandNup"))

        End Select

       Next

    ' output result data to sheet 2
    If result.Count = 0 Then
        MsgBox "No result data for output"
        Exit Sub
    End If
    With ThisWorkbook.Sheets(2)
        .Cells.Delete
        .Cells(1, 1).Resize(result.Count).Value = _
            WorksheetFunction.Transpose(result.Items())
    End With
    MsgBox "Completed"

End Sub

I manage to sucessfully rename columns with this, but it is not copying the columns in the second sheet, and evidently, not their content:

Option Explicit

Sub Changeheadername()

    Dim lastCol As Long, idCount As Long, nameCount As Long, headerRow As Long
    Dim rng As Range, cel As Range

    headerRow = 1       'row number with headers
    lastCol = Cells(headerRow, Columns.Count).End(xlToLeft).Column 'last column in header row
    idCount = 1
    nameCount = 1
    Set rng = Sheets("Sheet1").Range(Cells(headerRow, 1), Cells(headerRow, lastCol)) 'header range

    For Each cel In rng                     'loop through each cell in header
        If cel = "Wurp" Then             'check if header is "Wurp"
            cel = "Snouba"                    'rename 

        ElseIf cel = "Nabou" Then       'check if header is "Nabou"
            cel = "WAGD"                     'rename 

              ElseIf cel = "Scope 1" Then       'check if header is "Scope 1"
            cel = "I am an a wise rabbit"             

        End If
    Next cel
End Sub

Answer 1

Here is the example showing how you can refer to columns by their header names while processing table data, even if columns located in different order:

Option Explicit

Sub test()

    Const q = """"
    ' get source data table from sheet 1
    With ThisWorkbook.Sheets(1).Cells(1, 1).CurrentRegion
        ' check if data exists
        If .Rows.Count < 2 Or .Columns.Count < 2 Then
            MsgBox "No data table"
            Exit Sub
        End If
        ' retrieve headers name and column numbers dictionary
        Dim headers As Object
        Set headers = CreateObject("Scripting.Dictionary")
        Dim headCell
        For Each headCell In .Rows(1).Cells
            headers(headCell.Value) = headers.Count + 1
        Next
        ' check mandatory headers
        For Each headCell In Array("Client", "Info Superman", "ID", "Spec 1", "Spec 2", "Spec a", "Spec b", "Info costumer type", "Info facility type")
            If Not headers.Exists(headCell) Then
                MsgBox "Header '" & headCell & "' doesn't exists"
                Exit Sub
            End If
        Next
        Dim data
        ' retrieve table data
        data = .Resize(.Rows.Count - 1).Offset(1).Value
    End With
    ' process each row in table data
    Dim result As Object
    Set result = CreateObject("Scripting.Dictionary")
    Dim i
    For i = 1 To UBound(data, 1)
        Select Case True
            Case _
                data(i, headers("Client")) = "" Or _
                data(i, headers("Info Superman")) = "" Or _
                data(i, headers("ID")) = "" Or _
                data(i, headers("Info costumer type")) = "" Or _
                data(i, headers("Info facility type")) = ""
                    MsgBox "Empty row"
                    Exit For
            Case _
                data(i, headers("Spec 1")) = "" And _
                data(i, headers("Spec 2")) = "" And _
                data(i, headers("Spec a")) = "" And _
                data(i, headers("Spec b")) = ""
                    result(result.Count) = _
                        q & "Client " & data(i, headers("Client")) & _
                        q & q & "Superman " & data(i, headers("Info Superman")) & _
                        q & "Bravo" & _
                        q & "Info costumer type" & data(i, headers("Info costumer type")) & _
                        q & "Info facility type" & data(i, headers("Info facility type")) & _
                        q
            Case _
                data(i, headers("Spec a")) = "" And _
                data(i, headers("Spec b")) = ""
                    result(result.Count) = _
                        q & "Client " & data(i, headers("Client")) & _
                        q & q & "Superman " & data(i, headers("Info Superman")) & _
                        q & "AlphaBravo" & _
                        q & "Info costumer type" & data(i, headers("Info costumer type")) & _
                        q & "Info facility type" & data(i, headers("Info facility type")) & _
                        q
            Case Else
                    result(result.Count) = _
                        q & "Client " & data(i, headers("Client")) & _
                        q & q & "Superman " & data(i, headers("Info Superman")) & _
                        q & "AlphaAlphaBravo" & _
                        q & "Info costumer type" & data(i, headers("Info costumer type")) & _
                        q & "Info facility type" & data(i, headers("Info facility type")) & _
                        q
        End Select
    Next
    ' output result data to sheet 2
    If result.Count = 0 Then
        MsgBox "No result data for output"
        Exit Sub
    End If
    With ThisWorkbook.Sheets(2)
        .Cells.Delete
        .Cells(1, 1).Resize(result.Count).Value = _
            WorksheetFunction.Transpose(result.Items())
    End With
    MsgBox "Completed"

End Sub

The source data on the Sheet 1 I have tested is as follows:

And the output on the Sheet 2 is

That is just a boilerplate, you can easily change the code and adjust the logic for your exact layout.