Count Text across multiple sheets

Ok so I have a workbook with 29 sheets.

28 of those sheets contain a column with text data in them.

The text data in each column sometimes contains duplicate fields from sheet to sheet.

What I want to do is fill the 29th sheet with one column containing all of the other sheets names, and one row containing all of the different text fields from the data column without any duplicates. That part has already been completed manually, however, if a new text field had to be added to a certain sheet, I would need that new field to be automatically added to the new Master sheet into the row containing all the different text fields from the data columns.

Then for each name in my new 29th sheet, I want to put an "x" in the row/column cell if that text data appears in the individual sheets data column.

E.g I have 2 sheets. The first one is called Apples, the text data column might say: green, smooth, sour etc, with each word in an individual cell.
The second sheet is called Oranges, the text data column might say: Orange, smooth, round, sour etc.

I want to fill my new master sheet with a column listing the two sheet names (Apples, Oranges), a row with all the possible text data names without duplicates (Green, Orange, smooth, sour, round in our example), and then I want to input an "x" wherever the sheet name contains specific text data from the newly created row. In this case I would expect to see:



apples.png

Add this code to a regular codemodule, and run it first, and then again whenever you want to fully update the summary sheet: change the letter "B" to the column letter of your "column with text data" in both procedures, and save your workbook as a macro-enabled .xlsm

Option Explicit
Sub MakeSummarySheet()
    Dim rngC As Range
    Dim strAdd As String
    Dim shtS As Worksheet
    Dim shtD As Worksheet
    Dim i As Integer
    Dim c As Integer
    Dim lngR As Long
    Dim vReturn As Variant
    
    strAdd = "B"  'Column with Text
    
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets("Summary").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    Set shtD = Worksheets.Add(Before:=Worksheets(1))
    shtD.Name = "Summary"
    shtD.Cells(1, 1).Value = "Sheet Name"
    
    For i = 2 To Worksheets.Count
        Set shtS = Worksheets(i)
        lngR = shtD.Cells(shtD.Rows.Count, "A").End(xlUp)(2).Row
        shtD.Cells(lngR, 1).Value = shtS.Name
        For Each rngC In Intersect(shtS.UsedRange, shtS.Cells(1, strAdd).EntireColumn)
        If rngC.Value <> "" Then
            vReturn = Application.Match(rngC.Value, shtD.Range("1:1"), False)
            If IsError(vReturn) Then
                c = shtD.Cells(1, Columns.Count).End(xlToLeft)(1, 2).Column
                shtD.Cells(1, c).Value = rngC.Value
                shtD.Cells(lngR, c).Value = "X"
            Else
                shtD.Cells(lngR, vReturn).Value = "X"
            End If
        End If
        Next rngC
    Next i
    
End Sub

Then add this code to the codemodule of the Thisworkbook object, to automatically update the Summary sheet when values are added to the other sheets.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim strAdd As String
    Dim rngC As Range
    Dim shtS As Worksheet
    Dim lngR As Long
    Dim c As Integer
    Dim vReturn As Variant
    
    On Error GoTo ErrHandler
    
    strAdd = "B"  'Column with Text
    
    If Sh.Name = "Summary" Then Exit Sub
    If Target.Column <> Cells(1, strAdd).Column Then Exit Sub
    
    Application.EnableEvents = False
    
    Set shtS = Worksheets("Summary")
    
    vReturn = Application.Match(Sh.Name, shtS.Range("A:A"), False)
    If IsError(vReturn) Then
        lngR = shtS.Cells(Rows.Count, 1).End(xlUp)(2).Row
        shtS.Cells(lngR, 1).Value = Sh.Name
    Else
        lngR = vReturn
    End If
    
    For Each rngC In Target
        If rngC.Value <> "" Then
            vReturn = Application.Match(rngC.Value, shtS.Range("1:1"), False)
            If IsError(vReturn) Then
                c = shtS.Cells(1, Columns.Count).End(xlToLeft)(1, 2).Column
                shtS.Cells(1, c).Value = rngC.Value
                shtS.Cells(lngR, c).Value = "X"
            Else
                shtS.Cells(lngR, vReturn).Value = "X"
            End If
        End If
    Next rngC
    
ErrHandler:
    
    Application.EnableEvents = True
    
End Sub