Delete Sheet if contains only one column with text - excel

Question

I have a workbook with multiple sheets.
I want to check if each sheet has more than one column of content. If not delete it.
This would have to be deleted:
This not:

Answer 1

Try this code, please.
Edited: In order to answer your last question from the comment, the initial Sub will be adapted to call two other subs, able to add numbers to existing headers, in order to make them unique:
Sub deleteSheetsOneColumn()
Dim wb As Workbook, sh As Worksheet, nrCol As Long, i As Long
Set wb = ActiveWorkbook
For Each sh In wb.Worksheets
If sh.Cells(1, Columns.Count).End(xlToLeft).Column = 1 Then
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
Else
'testUniQHeaders sh 'the simple solution (need to uncomment it and comment the next line
testUniQueH sh 'comment the previous line, to make it working
End If
Next
End Sub
The code will also delete the empty sheets, too...
The next sub will simply add an incremented number to each existing header, making it unique:
Sub testUniQHeaders(sh As Worksheet)
Dim nrCol As Long, i As Long
nrCol = sh.Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To nrCol
sh.Cells(1, i).Value = sh.Cells(1, i).Value & " " & i
Next i
End Sub
The next one, will load each column header in a dictionary, in a tricky way and use the result in order to adapt only the headers appearing more then once:
Private Sub testUniQueH(sh As Worksheet)
Dim nrCol As Long, i As Long, dict As Object, strH As String, key As Variant
Dim arrK As Variant
Set dict = CreateObject("Scripting.Dictionary")
nrCol = sh.Cells(1, Columns.Count).End(xlToLeft).Column
'input cols in the dictionary
For i = 1 To nrCol
strH = sh.Cells(1, i).Value
If Not dict.Exists(strH) Then
dict.aDD key:=strH, Item:=Array(1, i) 'init number plus column number
Else
dict(strH) = Array(dict(strH)(0) + 1, dict(strH)(1) & "|" & i) 'add occurrences and col no
End If
Next i
For Each key In dict.Keys
If CLng(dict(key)(0)) > 1 Then
arrK = Split(dict(key)(1), "|")
For i = 1 To UBound(arrK)
sh.Cells(1, CLng(arrK(i))).Value = _
sh.Cells(1, CLng(arrK(i))).Value & " " & i
Next i
End If
Next
End Sub