Many Columns return into fewer columns.

Col A     COL B         COL C
DOG       Reg Number    CH, NA
This can allow you to see at one spot all titles that a dog has. Also can allow you easily by using filter find out which dogs have (a) certain titles(s)

or

Col A     COL B         COL C
DOG       Reg Number    CH
DOG       Reg Number    NA

Option Explicit

Public Sub columnsToText()
Dim maxColumns       As Long
Dim sourceSheet      As String
Dim animalCol        As Integer
Dim registrationCol  As Integer
Dim maxRows          As Long
Dim newSheet         As String
Dim formula          As String
Dim startCol         As Integer

   sourceSheet = "Sheet1"

   With Sheets(sourceSheet)
      maxColumns = getItemLocation("*", .Cells, bFindRow:=False)
      maxRows = getItemLocation("*", .Cells)
      Sheets.Add
      newSheet = ActiveSheet.Name
      Application.CutCopyMode = False
      .Range(.Cells(1, 1), .Cells(maxRows, maxColumns)).Copy
      Sheets(newSheet).Cells(1, 1).PasteSpecial
      Application.CutCopyMode = False
   End With
   
   With Sheets(newSheet)
      animalCol = getItemLocation("Dog", .Rows(1), bFindRow:=False)
      .Columns(animalCol).Cut
      .Range("A1").Insert Shift:=xlToRight
      Application.CutCopyMode = False
      registrationCol = getItemLocation("Reg Number", .Rows(1), bFindRow:=False)
      .Columns(registrationCol).Cut
      .Range("B1").Insert Shift:=xlToRight
      Application.CutCopyMode = False
      .Columns(3).Insert Shift:=xlToRight
      maxColumns = maxColumns + 1
   
      Do While (maxColumns > 3)
         startCol = 4
         formula = getConcatFormula(startCol, maxColumns)
         Application.CutCopyMode = False
         With .Range(.Cells(1, 3), .Cells(maxRows, 3))
            .FormulaR1C1 = "=" & formula
            .Copy
            .PasteSpecial xlPasteValues
         End With
         Application.CutCopyMode = False
         .Range(.Cells(1, 4), .Cells(1, startCol)).EntireColumn.Delete Shift:=xlToLeft
         maxColumns = maxColumns - startCol + 3
         If (maxColumns > 3) Then
            Application.CutCopyMode = False
            .Columns(3).Insert Shift:=xlToRight
            maxColumns = maxColumns + 1
            Application.CutCopyMode = False
         End If
      Loop
      Application.CutCopyMode = False
      With .Range(.Cells(1, 4), .Cells(maxRows, 4))
         .FormulaR1C1 = "=trim(Rc[-1])"
         .Copy
         .PasteSpecial xlPasteValues
      End With
      Application.CutCopyMode = False
      .Range(.Cells(1, 3), .Cells(1, 3)).EntireColumn.Delete Shift:=xlToLeft
      .Range(.Cells(1, 3), .Cells(maxRows, 3)).Replace What:="  ", Replacement:=" "
      .Cells(1, 3).Value = "Titles"
      .Columns(1).AutoFit
      .Columns(2).AutoFit
      .Columns(3).AutoFit
      Application.CutCopyMode = False
   End With
End Sub

Public Function getConcatFormula(ByRef startCol As Integer, ByVal maxColumns As Integer) As String
   
   Dim formula As String
   Dim count   As Integer
   
   formula = vbNullString
   For count = 0 To 99
      formula = formula & "&RC" & (startCol + count) & "&"" """
      If (startCol + count >= maxColumns) Then Exit For
   Next
   If (count > 99) Then count = count - 1
   startCol = startCol + count
   getConcatFormula = Mid(formula, 2)

End Function