Cells A1:L1 have contents in them. I want to create a code so that if these
same contents appear again in any row between A2:L200 that row will be
deleted. Any thoughts?

Hi

This should cover it for you.

take care

Marcus

Sub FindandDel()
Dim rgFoundCell As Range
Dim strFindMe As String
Dim i As Long
'Handles columns A to L
For i = 1 To 12
strFindMe = Cells(1, i).Value
Application.ScreenUpdating = False
With Sheet1 'Change sheet name to appropriate, also range A2:L200
Set rgFoundCell = .Range("A2:L200").Find(what:=strFindMe)
Do Until rgFoundCell Is Nothing
rgFoundCell.EntireRow.Delete
Set rgFoundCell = .Range("A2:L200").FindNext
Loop
End With
Next i

Application.ScreenUpdating = True

End Sub

Hi Marcus,

Thank you for your input. I added your code to the one I already had. For
some reason after the orginal steps were completed the macro stopped and an
hour glass came up. I also tried the code by itself and the same thing
happened with the hour glass. In both cases I let the hour glass go for a
couple minutes but nothing happened so I ended the program because it locked
up. I am not sure if it's something I did incorrectly. Below are the two
codes that I tried.

Code #1
Rows("1:3").Select
Selection.Delete Shift:=xlUp
Range("A1").Select
ActiveCell.FormulaR1C1 = "Order Type"
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
Columns("O:O").Select
Selection.Cut
Columns("H:H").Select
Selection.Insert Shift:=xlToRight
Range("M1").Select
ActiveCell.FormulaR1C1 = "Part Number"
Columns("M:M").Select
Selection.Cut
Columns("I:I").Select
Selection.Insert Shift:=xlToRight
Columns("N:N").Select
Selection.Cut
Columns("J:J").Select
Selection.Insert Shift:=xlToRight
Columns("L:O").Select
Selection.Delete Shift:=xlToLeft
Columns("M:P").Select
Selection.Delete Shift:=xlToLeft
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

Firstrow = ActiveSheet.UsedRange.Cells(1).Row
Lastrow = ActiveSheet.UsedRange.Rows.Count + Firstrow - 1
With ActiveSheet
.DisplayPageBreaks = False
For Lrow = Lastrow To Firstrow Step -1
If Application.CountA(.Range(.Cells(Lrow, "A"), .Cells(Lrow,
"L"))) = 0 Then .Rows(Lrow).Delete
Next
End With
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With

Dim rgFoundCell As Range
Dim strFindMe As String
Dim i As Long
'Handles columns A to L
For i = 1 To 12
strFindMe = Cells(1, i).Value
Application.ScreenUpdating = False
With Sheet1 'Change sheet name to appropriate, also range A2:L200
Set rgFoundCell = .Range("A2:L200").Find(what:=strFindMe)
Do Until rgFoundCell Is Nothing
rgFoundCell.EntireRow.Delete
Set rgFoundCell = .Range("A2:L200").FindNext
Loop
End With
Next i

Application.ScreenUpdating = True

End Sub

Code # 2

Sub FindandDel()
Dim rgFoundCell As Range
Dim strFindMe As String
Dim i As Long
'Handles columns A to L
For i = 1 To 12
strFindMe = Cells(1, i).Value
Application.ScreenUpdating = False
With Sheet1 'Change sheet name to appropriate, also range A2:L200
Set rgFoundCell = .Range("A2:L200").Find(what:=strFindMe)
Do Until rgFoundCell Is Nothing
rgFoundCell.EntireRow.Delete
Set rgFoundCell = .Range("A2:L200").FindNext
Loop
End With
Next i

Application.ScreenUpdating = True

End Sub



"marcus" wrote:

Hi

This should cover it for you.

take care

Marcus

Sub FindandDel()
Dim rgFoundCell As Range
Dim strFindMe As String
Dim i As Long
'Handles columns A to L
For i = 1 To 12
strFindMe = Cells(1, i).Value
Application.ScreenUpdating = False
With Sheet1 'Change sheet name to appropriate, also range A2:L200
Set rgFoundCell = .Range("A2:L200").Find(what:=strFindMe)
Do Until rgFoundCell Is Nothing
rgFoundCell.EntireRow.Delete
Set rgFoundCell = .Range("A2:L200").FindNext
Loop
End With
Next i

Application.ScreenUpdating = True

End Sub