Macro to Delete IF

[Djblois]

I am looking to write a macro that will delete the lines if it finds particular characters. If it doesn't find these characters it will automatically go to the next step. The problem is these characters will always be in the A column but I don't know what row they will be in. I know how to do it if I knew which cell it would show in but I need to do a relative reference. I would really appreciate help in this area.

Daniel

[lucas]

Hi Daniel,
try this it will delete the entire row if it contains the word test in column A. Option compare text will let it delete rows with the word test spelled with caps or small letters Test or test will be deleted. If you want it to be cap sensitive then just remove or coment the line Option compare text.

Option Explicit
Option Compare Text
Sub DeleteRows()
Dim test As Boolean, x As Long, lastrow As Long, col As Long
Range("A8").Select
col = ActiveCell.Column
lastrow = Cells(65536, col).End(xlUp).Row
For x = lastrow To 1 Step -1
test = Cells(x, col).Text Like "Test"
If test = True Then Cells(x, col).EntireRow.Delete
Next
End Sub

[Djblois]

Steve sorry to bother you but I am trying to get it to work and I can't. Here is my code:

Range("A:A").Select
Selection.Find(What:="Profile", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlLast, MatchCase:= _
False, SearchFormat:=False).SelectSelection.Find(What:="Customer").Select
'Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select


This is part of a much larger macro. Where and how would I replace my code with yours?

Thank you,
Daniel

[lucas]

Daniel,
Are you trying to find the word "Profile" in column A and if found delete the entire row or just select it?

Also are you looking for multiple criteria, eg. also looking for "Customer" and delete those rows?

[lucas]

Here's an example using one criteria

[Djblois]

Steve thanks that works but can you help me alter it a little. If it finds Profile then it will delete that row and every one after it.

Daniel

[lucas]

I must be misunderstansifying you Daniel....Do you mean everything or just every instance of "Profile"?!?

see attachment

It doesn't delete any rows that don't have "profile" in column A for me..See example. Now if you want to leave some instances of Profile thats different.

By the way, you have been pretty busy here and you haven't given us the whole of what your trying to do, only bits of code in 4 or 5 posts. Is this an assignment or can we see the whole thing. Might make it easier to put it together. Remove any sensitive data.

[Djblois]

ok sorry, it is a Macro I am writing for my internship. They have a terrible system here that whenever myself or anybody else prints a sales report we need to clean it up. Delete rows of garbage, add customer names, product names, etc. Here is the code:

Sub CleanData()
'
' Macro1 Macro
' Macro recorded 5/19/2006 by Administrator
'
' Keyboard Shortcut: Ctrl+Shift+C
'
Application.ScreenUpdating = True
Application.DisplayAlerts = False
Set WB = ActiveWorkbook
'Name Sheet1
MyInput = InputBox("What do you want to name the Worksheet?")
Sheets("Sheet1").Name = MyInput

'Sort
Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers

'Delete extra
Columns("A:A").Select
Selection.Find(What:="AT", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Select
ActiveCell.Offset(-1, 0).Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.EntireRow.Delete
'Create Customer and Product worksheet
Columns("A:A").Select
Selection.Find(What:="Customer:", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Cut
Sheets.Add.Name = "Customers"
Range("A1").Select
ActiveSheet.Paste
Columns("A:A").Select
Selection.Find(What:="Product:", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=last, MatchCase:= _
False, SearchFormat:=False).Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Cut
Sheets.Add.Name = "Products"
Range("A1").Select
ActiveSheet.Paste

'Delete any rows that start with "Profile"
'For i = 2 To 7000
'If Cells(i, 1).Value = "Profile" Then
'Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
'Selection.EntireRow.Delete
'End If
'Next I
DeleteProfile

'Remove ( and ) from data
Columns("A:A").Select
Selection.Replace What:="(", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:=")", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Sheets("Customers").Select
Range("A:A").Select
Selection.Replace What:="(", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:=")", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

'Delete any rows that start with "Date"
Columns("A:A").Select
For I = 2 To 3000
If Cells(I, 1).Value = "Date" Then
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.EntireRow.Delete
End If
Next I

'Create Cust# Column
Range("H1").Select
ActiveCell.FormulaR1C1 = "=Mid(RC[-7],11,4)"
Selection.Copy
ActiveCell.Offset(0, -7).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 7).Range("A1").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues

'Create Customer Column
Range("I1").Select
ActiveCell.FormulaR1C1 = "=PROPER(Trim(MID(RC[-8],16,50)))"
Selection.Copy
ActiveCell.Offset(0, -8).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 8).Range("A1").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues

'Create headings for Customer worksheet
Columns("A:G").Delete Shift:=xlToLeft
Rows("1:1").Insert Shift:=xlDown
Range("A1").FormulaR1C1 = "Cust#"
Range("B1").FormulaR1C1 = "Customer"
Range("A1:B1").Select
With Selection
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 1
End With
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True

'Create Item# Column
Sheets("Products").Select
Range("H1").Select
ActiveCell.FormulaR1C1 = "=RIGHT(RC[-7],6)"
Selection.Copy
ActiveCell.Offset(0, -7).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 7).Range("A1").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues

'Create Products Column
Range("I1").Select
ActiveCell.FormulaR1C1 = "=PROPER(Trim(MID(RC[-8],10,80)))"
Selection.Copy
ActiveCell.Offset(0, -8).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 8).Range("A1").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues

'Create headings for Product worksheet
Columns("A:G").Delete Shift:=xlToLeft
Rows("1:1").Insert Shift:=xlDown
Range("A1").FormulaR1C1 = "Item#"
Range("B1").FormulaR1C1 = "Product"
Range("A1:B1").Select
With Selection
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 1
End With
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True

'Save Workbook as User Input
Sheets(3).Select
MyInput = InputBox("What do you want to name the File?")
ActiveWorkbook.SaveAs Filename:= _
"H:\@temp\Daniel B\Current Projects\" & MyInput
'ActiveWorkbook.SaveAs Filename:= _
"H:\@temp\Daniel B\Current Projects\Current"

'Delete Columns
Columns("C:C").Delete Shift:=xlToLeft
Columns("F:F").Delete Shift:=xlToLeft
Columns("P:P").Delete Shift:=xlToLeft

'Insert Columns
Columns("D:D").Insert Shift:=xlToRight
Columns("F:F").Insert Shift:=xlToRight
Columns("H:H").Insert Shift:=xlToRight
Columns("J:K").Insert Shift:=xlToRight

'Add headers with formating
Rows("1:1").Insert Shift:=xlDown
Range("A1").FormulaR1C1 = "Invoice#"
Range("B1").FormulaR1C1 = "Date"
Range("C1").FormulaR1C1 = "Whse#"
Range("E1").FormulaR1C1 = "Cust#"
Range("G1").FormulaR1C1 = "Sls#"
Range("I1").FormulaR1C1 = "Item#"
Range("L1").FormulaR1C1 = "Qty"
Range("M1").FormulaR1C1 = "Units"
Range("N1").FormulaR1C1 = "Price"
Range("O1").FormulaR1C1 = "D"
Range("P1").FormulaR1C1 = "Amt"
Range("Q1").FormulaR1C1 = "Equivalant"
Range("R1").FormulaR1C1 = "Ext-Cost"
Range("S1").FormulaR1C1 = "Unit-Cost"
Range("T1").FormulaR1C1 = "Profit"
Range("U1").FormulaR1C1 = "%"
Range("A1:U1").Select
With Selection
.HorizontalAlignment = xlCenter
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 1
End With

'Clean Bottem of Database
'For I = 2 To 65000
'If Cells(i, 1).Value = "Atalanta" Then
'Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
'Selection.EntireRow.Delete

'test = Cells(x, col).Text Like "Test"
'If test = True Then Cells(x, col).EntireRow.Delete
'End If
'Next I

'Open Atalanta Codes workbook
Workbooks.Open Filename:="H:\@temp\Daniel B\Reference\Atalanta Codes.xls"
WB.Activate

'Add Warehouses
Columns("C:C").Select
Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Range("D2").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-1],'[Atalanta Codes.xls]Whses'!C1:C8,2,FALSE)"
Selection.Copy
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Range("D1").FormulaR1C1 = "Whse"

'Add Customers from Atalanta Codes
Columns("E:E").Select
Selection.TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Range("F2").Select
'ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-1],'[Atalanta Codes.xls]Cust'!C1:C9,2,FALSE)"
'Selection.Copy
'ActiveCell.Offset(0, -1).Range("A1").Select
'Selection.End(xlDown).Select
'ActiveCell.Offset(0, 1).Range("A1").Select
'Range(Selection, Selection.End(xlUp)).Select
'ActiveSheet.Paste
'Selection.Copy
'Selection.PasteSpecial Paste:=xlPasteValues


'Add Customers from Customer List
'Selection.Sort Key1:=Range("F2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'Columns("E:E").Select
'If Selection.Find(What:="#N/A\") Then
'Selection.Find(What:="#N/A\").Select
'Selection.Insert Shift:=xlDown
'ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Customers!C[-5]:C[-4],2,FALSE)"
Selection.Copy
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
'Selection.End(xlDown).Select
'ActiveCell.Offset(0, -1).Range("A1").Select
'Selection.EntireRow.Delete
Range("F1").FormulaR1C1 = "Customer"
'Else

'Add SlsPrsn
Columns("G:G").Select
Selection.TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Range("H2").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-1],'[Atalanta Codes.xls]SlsPrsn'!C1:C8,2,FALSE)"
Selection.Copy
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Range("H1").FormulaR1C1 = "SlsPrsn"

'Add Product
Columns("I:I").Select
Selection.TextToColumns Destination:=Range("I1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Range("J2").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Products!C[-9]:C[-8],2,FALSE)"
Selection.Copy
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Range("J1").FormulaR1C1 = "Product"

'Add Dept
Range("K2").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-2],'[Atalanta Codes.xls]Products'!C1:C12,3,FALSE)"
Selection.Copy
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Range("K1").FormulaR1C1 = "Dept"

'Add Delivery, XWhse
Range("N2").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
Range(Selection, Selection.End(xlUp)).Select
Selection.Replace What:="", Replacement:="Exw", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="D", Replacement:="Del", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

'Close Atlanta Codes workbook and delete product and customer lists
Windows("Atalanta Codes.xls").Close
Sheets("Customers").Delete
Sheets("Products").Delete

'Fix Date
Columns("B:B").Select
Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 3), TrailingMinusNumbers:=True
Selection.NumberFormat = "mm/d/yy;@"

'Fix Qty
Columns("L:L").Select
Selection.TextToColumns Destination:=Range("L1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Selection.NumberFormat = "#,##0"

'Fix Units
Columns("M:M").Select
Selection.TextToColumns Destination:=Range("M1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Selection.Style = "Comma"

'Fix Price
Columns("N:N").Select
Selection.TextToColumns Destination:=Range("N1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Selection.Style = "Comma"

'Fix Amt
Columns("P:P").Select
Selection.TextToColumns Destination:=Range("P1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Selection.NumberFormat = "#,##0"

'Fix Equivalant
Columns("Q:Q").Select
Selection.TextToColumns Destination:=Range("Q1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Selection.NumberFormat = "#,##0"

'Fix Ext-Cost
Columns("R:R").Select
Selection.TextToColumns Destination:=Range("R1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Selection.NumberFormat = "#,##0"

'Fix Unit-Cost
Columns("S:S").Select
Selection.TextToColumns Destination:=Range("S1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Selection.NumberFormat = "#,##0"

'Fix Profit
Columns("T:T").Select
Selection.TextToColumns Destination:=Range("T1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Selection.NumberFormat = "#,##0"

'Add Percentage to End
Range("U2").Select
ActiveCell.FormulaR1C1 = "=RC[-1]/RC[-5]"
Selection.Copy
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Range("A1").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Columns("U:U").NumberFormat = "0.00%"

'Set Print Headings
With ActiveSheet.PageSetup
.LeftHeader = "&""Arial,Bold""&12Grocery Dept."
.CenterHeader = "&""Arial,Bold""&14&A"
.RightHeader = "&""Arial,Bold""&12Sorted by"
.LeftFooter = "&""Arial,Bold""&D &T Dan Blois"
.CenterFooter = "&""Arial,Bold""&F"
.RightFooter = "&""Arial,Bold""Page &P of &N"
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.9)
.BottomMargin = Application.InchesToPoints(0.6)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintGridlines = True
.CenterHorizontally = True
.FitToPagesWide = 1
.PrintTitleRows = "$1:$1"
End With
'End If

ActiveWorkbook.Save
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub



I didn't post it because it is so long. I know I need to clean it up also, any help would be greatly appreciated as I want to be a better programmer. Just to let you know I am a business student but I feel Macro writing is an invaluable skill as I move up in my career to get more things done in less time.

[Djblois]

You weren't misunderstanding me I explained it wrong. I need to Delete find Profile and then delete Profile and everything after it. Don't worry your code helped me in another spot.

[lucas]

Well Daniel, I just don't know what to say. I am pretty much a novice at this myself so here are just a couple of things I have noticed. Hope one of the sharper members come along to help you out.

1st thing I see is that a lot of this could be done with a template...headers, formatting, etc.

second thing I see that could be improved is that you do a lot of selecting, then copy, paste, etc. take a look at post 2 of this thread....only select is to pick a cell in the column we wish to perform the operation on.

ps did you get to look at the attachment from post#7

[lucas]

Oh, so that is what you want....to find profile and then delete everything after it?........?

It would really help if you would take the time to think about your questions and word them so an old cow hand can follow ya...we're kinda slow.....

[Djblois]

How do you do templates? I have no idea on that one.

[lucas]

Set up your sheet the way you want it then do a file-saveas .xlt or template

[Djblois]

Option Explicit

Option Compare Text
Sub DeleteRows()
Dim test As Boolean, x As Long, lastrow As Long, col As Long
Range("A8").Select
col = ActiveCell.Column
lastrow = Cells(65536, col).End(xlUp).Row
For x = lastrow To 1 Step -1
test = Cells(x, col).Text Like "Test"
If test = True Then Cells(x, col).EntireRow.Delete
Next
End Sub


I get this to work but I would like to put it into a much larger macro. Right now I have it in a seperate module. How can I do this?

[lucas]

Hi Daniel,
You can call the DeleteRows macro from your other routine like this on a line by itself:

call DeleteRows


or you can just put this part in your code and see if you have any conflicts: I would put the Dim line(first line) at the very top of the module but you don't have to.
Dim test As Boolean, x As Long, lastrow As Long, col As Long
Range("A8").Select
col = ActiveCell.Column
lastrow = Cells(65536, col).End(xlUp).Row
For x = lastrow To 1 Step -1
test = Cells(x, col).Text Like "Test"
If test = True Then Cells(x, col).EntireRow.Delete
Next

[Djblois]

Lucas,

Thank you for all your help but what about the Option Explicit and Option Compare Text where would I put them?

[Djblois]

the reason why I am trying to put it into one module is I am installing this Macro around my office and it would be easier to copy one module than 2. I also plan on updating it and if I update that part of the macro I will have to update two modules also.

[lucas]

Option explicit and Option compare text must be at the very top of the code module. Outside of any subs