Speeding up a loop, that does an action when encounters a value

[j.smith1981]

I have a long section of a macro in Excel 2007.

What it does at the moment is loop down, finds a value like say '#N/A' from a VLOOKUP function.

Removes an entire row if it finds that value, removes the entire row and carries on down until there's no more rows of data to check.

But we are adding almost 3 times as many rows through a products upload of an entire catalogue, here's the code at the moment we have:


Obviously picking the cell to start off from i.e. cells(1,1).select , then does this:
[VBA] Do
If ActiveCell.Formula = "#N/A" Then
Selection.EntireRow.Delete Shift:=xlUp
Else
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell.Offset(0, 1))[/VBA]

Is there anyway of doing this so it saves me allot of time in the macro?

Like select the whole range in a column and then removing them all at once?

I would really appreciate some advice here and as always thanks for any help in advance,
Jeremy.

[Bob Phillips]

[vba]

Public Sub ProcessData()
Const TEST_COLUMN As String = "P" '<=== change to suit
Dim LastRow As Long
Dim rng As Range

With ActiveSheet

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
.Rows(1).Insert
.Cells(1, TEST_COLUMN).Value2 = "temp)"
Set rng = .Cells(1, TEST_COLUMN).Resize(LastRow + 1)
rng.AutoFilter Field:=1, Criteria1:="#N/A"
On Error Resume Next
Set rng = rng.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not rng Is Nothing Then rng.EntireRow.Delete
End With

End Sub
[/vba]

[j.smith1981]

Thanks ever so much for that, I really appreciate it!

Going on another example of this.

I have a form of a CTRL+F function that finds say a cartridge LC02BK in the current cell yea?

Next ones LC1000BK, these are all ink cartridges yea?

They belong to multiple printers right?

This is a working solution I have, just takes for ever to complete, would there be a faster, probably more convenient way of doing this?

[VBA]Dim fileLoc As String
Dim productcode_fulldescr As String
Dim cat As String
Dim subcat As String

'Opens datasheet for full descr process
fileLoc = ThisWorkbook.Path
Application.Workbooks.Open (fileLoc & "\" & "dataSheet.xls")

Application.Workbooks("dataSheet.xls").Activate

Sheets("Laser Cartridge-Printer Linking").Select

ActiveSheet.UsedRange.Select
Selection.copy

Sheets("Ink Cartridge-Printer Linking").Select

Cells.Find(What:="*", After:=[A1], SearchDirection:=xlPrevious).Select
ActiveCell.Offset(1, -2).Select

ActiveSheet.Paste


Application.Workbooks("UPLOADproducts.xlsm").Activate

Do While IsEmpty(ActiveCell.Offset(0, -1)) = False

productcode_fulldescr = ActiveCell.Formula 'Saves the current cell value as variable

Application.Workbooks("dataSheet.xls").Activate 'Activates data sheet
Sheets("Ink Cartridge-Printer Linking").Select

Cells(2, 3).Select


Dim R As Range, FindAddress As String

'Set the range in which we want to search in
With ActiveSheet.Range("C1:C65536") ' Set to column(s) with product codes going all the way down to the bottom of excel list!

'Search for the first occurrence of the item
Set R = .Find(productcode_fulldescr) 'Finds product code

'If a match is found then
If Not R Is Nothing Then
'Store the address of the cell where the first match is found in a variable
FindAddress = R.Address

Do

R.Select 'Selects found item cell

ActiveCell.Offset(0, -2).Select
cat = ActiveCell.Value

ActiveCell.Offset(0, 1).Select

subcat = ActiveCell.Value

ActiveCell.Offset(0, 1).Select

Application.Workbooks("UPLOADproducts.xlsm").Activate 'Activates last products CSV file

ActiveCell.Offset(0, 3).Select

ActiveCell.Value = ActiveCell.Value & " " & cat & " " & subcat & "<br />"

ActiveCell.Offset(0, -3).Select

Application.Workbooks("dataSheet.xls").Activate

'Search for the next cell with a matching value
Set R = .FindNext(R)
'Search for all the other occurrences of the item i.e.
'Loop as long matches are found, and the address of the cell where a match is found,
'is different from the address of the cell where the first match is found (FindAddress)

Loop While Not R Is Nothing And R.Address <> FindAddress


End If

End With

Application.Workbooks("UPLOADproducts.xlsm").Activate
ActiveCell.Offset(1, 0).Select 'Happens after the current productcode has been found/not found

Loop
Cells(1, 1).Select


'Clear memory
Set R = Nothing[/VBA]

Again much appreciated for any replies,
Jeremy.

[Aussiebear]

yea as in yes, I presume you mean?