Delete Duplicate Header Macro

[Workbook]

Row A1:L1 contain the following contents.
A1 = OT
B1 = ON
C1 = PT
D1 = M
E1 = SN
F1 = AD&T
H1 = RQ
I1 = PN
J1 = D
K1 = P
L1 = SL
I would like to search A2:L100 for these contents and every time I find them
in a row to have that row be deleted. Any input is greatly appreciated.

 

[Joel]

I'm not sure if it was worth the effort to use Find/FindNext because of all
the problems I ran into. I show you tow methods and you decide which is
better



Sub DeleteRows()

With ActiveSheet
LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
LastRow = .Range("A" & Rows.Count).End(xlUp).Row

Set DataRange = .Range("A1", .Cells(LastRow, LastCol))
For ColCount = 1 To LastCol
Header = .Cells(1, ColCount)
Set HeaderCell = .Cells(1, ColCount)
Set c = DataRange.Find(what:=Header, LookIn:=xlValues,
SearchOrder:=xlByRows, _
after:=Cells(1, LastCol))
If Not c Is Nothing And c.Row <> 1 Then
Do
Set EndRow = Cells(c.Row - 1, LastCol)
c.EntireRow.Delete
Set c = DataRange.Find(what:=Header, after:=EndRow, _
LookIn:=xlValues, SearchOrder:=xlByRows)
Loop While Not c Is Nothing And c.Row <> 1
End If

Next ColCount
End With


End Sub

or

Sub DeleteRows2()

With ActiveSheet
LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
Set Headers = .Range("A1", .Cells(1, LastCol))

RowCount = LastRow
Do While RowCount >= 2

For Each Header In Headers
Set RowCells = .Range(.Cells(RowCount, "A"), .Cells(RowCount,
LastCol))
Set c = RowCells.Find(what:=Header, LookIn:=xlValues)
If Not c Is Nothing Then
Rows(RowCount).Delete
Exit For
End If
Next Header
RowCount = RowCount - 1
Loop
End With

End Sub

 

[Dave Peterson]

Option Explicit
Sub testme()

Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long

Dim iCol As Long
Dim FirstCol As Long
Dim LastCol As Long
Dim FoundADifference As Boolean

Dim wks As Worksheet

Set wks = Worksheets("Sheet1")

With wks
FirstRow = 2
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

FirstCol = .Range("A1").Column
LastCol = .Range("L1").Column

'start at bottom and work up
For iRow = LastRow To FirstRow Step -1
FoundADifference = False
For iCol = FirstCol To LastCol
If .Cells(iRow, iCol).Value = .Cells(1, iCol).Value Then
'keep looking
Else
FoundADifference = True
Exit For 'stop looking
End If
Next iCol
If FoundADifference = True Then
'keep it
Else
.Rows(iRow).Delete
End If
Next iRow
End With

End Sub