Making my full macro much faster

[j.smith1981]

I am having problems with a macro I am trying to write.

Well I have written it, it just takes way to long to run, any advice would be great.

The only problem is, it wont let me copy in the code, I think its way too long, hows the best way of showing someone, I mean the macro thats coded at the moment, is rather basic, but it works, but I thought there has to be a quicker way for doing this work, its just stupid really, definately my fault, but thats how we learn isnt it?

Hows the best way of showing you guys my code?

[Bob Phillips]

How about an extract, the problem might be clear from that?

[j.smith1981]

Here's a one that really takes allot of time:

fileLoc = ThisWorkbook.Path

'------------------------------------------------------------------------------------

Application.Workbooks.Open ("C:\UPLOADproducts.csv") ' Opens the last generated CSV file overwrites!

Application.Workbooks.Open (fileLoc & "\" & "dataSheet.xls") ' Opens the data workbook

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

Cells(3, 1).Select


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

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


Application.Workbooks("dataSheet.xls").Activate 'Activates data sheet
Sheets("subCategories2").Select

Cells(2, 4).Select


Dim R As Range, FindAddress As String

'Set the range in which we want to search in
With ActiveSheet.Range("D1:D65536") ' 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) '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, 2).Select


Dim i2 As Integer
Dim catUsed As Integer


i2 = ActiveCell.Value

i2 = i2 + 1

ActiveCell.Formula = i2


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

ActiveCell.Offset(1, 0).Select

ActiveCell.EntireRow.Insert Shift:=xlDown

ActiveCell.Offset(0, 6).Select

ActiveCell.Formula = cat & "/" & subcat

ActiveCell.Offset(0, -6).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.csv").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

Basically I have a list of products which is processed with another previous macro (kept them seperate so as to structure it sort of thing).

But what it does basically is, go down a cell in the products file, if a value exists in a column cell.

Copy that value to a variable.

Go over to another sheet.

CTRL+F on that value

Finds the value, if not goes back to products file and goes down again to find a value and repeat the process until no values exist in the cell below.

Once it finds a value in the categories file, it moves to a cell and copies that value.

Goes back into the products file creates a row below the cell it was in before switching over and enters that value below.

Continues for all matching values of that product.

Basically this is to make printer models for our web store.

Thats the basic game for this macro, any advice on speeding this up as its taking 10minutes to complete and its not even half way done yet, the categories file so its going to take longer when we have all the categories x reference list.

Thanks again in advance,
Jeremy.

[Bob Phillips]

Th obvious thing to suggest is DON'T Select

Change



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, 2).Select


Dim i2 As Integer
Dim catUsed As Integer


i2 = ActiveCell.Value



to



Do

With R

cat = .Offset(0, -2).Value
subcat = .Offset(0, 1).Value

Dim i2 As Integer

i2 = .Offset(0, 2).Value


etc., and maybe turn off automatic calculation and screenupdating

[j.smith1981]

Wonderfull, didnt realise how simple this could be.

Will definately give it a go, actually a few modifications exist in this macro I will change those aswell, thanks ever so much for the heads up will be reffering to this from now on.

Many thanks!
Jeremy.

[j.smith1981]

Ah I have another problem, seems its not working quite fully yet.

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

This brings up:

Compile error

Loop without Do



This is the code I have so far in its entirity.
Sub subCategoryFIND()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim fileLoc As String
Dim productcode As String
Dim cat As String
Dim subcat As String
Dim categoriesFile As String
Dim i As Integer
Dim categoryName As String

fileLoc = ThisWorkbook.Path

'------------------------------------------------------------------------------------

Application.Workbooks.Open ("C:\UPLOADproducts.csv") ' Opens the last generated CSV file overwrites!

Application.Workbooks.Open (fileLoc & "\" & "dataSheet.xls") ' Opens the data workbook

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

Cells(3, 1).Select


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

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


Application.Workbooks("dataSheet.xls").Activate 'Activates data sheet
Sheets("subCategories2").Select

Cells(2, 4).Select


Dim R As Range, FindAddress As String

'Set the range in which we want to search in
With ActiveSheet.Range("D1:D65536") ' 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) '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

'OLD METHOD NOT THE MOST EFFICIENT! COMMENTED OUT FOR DEVELOPMENT PURPOSES
' 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, 2).Select
'
'
' Dim i2 As Integer
' Dim catUsed As Integer


' i2 = ActiveCell.Value

' i2 = i2 + 1

' ActiveCell.Formula = i2
Do

With R

cat = .Offset(0, -2).Value
subcat = .Offset(0, 1).Value

Dim i2 As Integer

i2 = .Offset(0, 2).Value

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

ActiveCell.Offset(1, 0).Select

ActiveCell.EntireRow.Insert Shift:=xlDown

ActiveCell.Offset(0, 6).Select

ActiveCell.Formula = cat & "/" & subcat

ActiveCell.Offset(0, -6).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 'This is what its complaining about


End If

End With

Application.Workbooks("UPLOADproducts.csv").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

Thats the code I have at the moment.

Its probably something I am not seeing here but cant get my head around the code at the moment I do apologise.

Any suggestions though?

[Bob Phillips]

You are missing an End With before that final Loop.

[j.smith1981]

Hahaha, woops :banghead:

Sorry lol.

Will see how this works, thanks ever so much for your help, I wasnt exactly bright yesturday.

[j.smith1981]

That doesnt work, it doesnt follow through with all printer models, this is an absolute must, here's the code I have so far anyhow:

Sub subCategoryFIND()

Application.ScreenUpdating = True
Application.DisplayAlerts = False

Dim fileLoc As String
Dim productcode As String
Dim cat As String
Dim subcat As String
Dim categoriesFile As String
Dim i As Integer
Dim categoryName As String

fileLoc = ThisWorkbook.Path

'------------------------------------------------------------------------------------

Application.Workbooks.Open ("C:\UPLOADproducts.csv") ' Opens the last generated CSV file overwrites!

Application.Workbooks.Open (fileLoc & "\" & "dataSheet.xls") ' Opens the data workbook

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

Cells(3, 1).Select


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

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


Application.Workbooks("dataSheet.xls").Activate 'Activates data sheet
Sheets("subCategories2").Select

Cells(2, 4).Select


Dim R As Range, FindAddress As String

'Set the range in which we want to search in
With ActiveSheet.Range("D1:D65536") ' 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) '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

'OLD METHOD NOT THE MOST EFFICIENT! COMMENTED OUT FOR DEVELOPMENT PURPOSES
' 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, 2).Select
'
'
' Dim i2 As Integer
' Dim catUsed As Integer


' i2 = ActiveCell.Value

' i2 = i2 + 1

' ActiveCell.Formula = i2
Do

With R

cat = .Offset(0, -2).Value
subcat = .Offset(0, 1).Value

Dim i2 As Integer

'i2 = .Offset(0, 2).Value

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

ActiveCell.Offset(1, 0).Select

ActiveCell.EntireRow.Insert Shift:=xlDown

ActiveCell.Offset(0, 6).Select

ActiveCell.Formula = cat & "/" & subcat

ActiveCell.Offset(0, -6).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)

End With
Loop While Not R Is Nothing And R.Address <> FindAddress 'This is what its complaining about


End If



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

End With

Loop
Cells(1, 1).Select


'Clear memory
Set R = Nothing

Is there anyway of doing this still? I want all models inserted below, I know this is sort of a comparison thing, but just wondered about improving it.

Can someone else help maybe?

[Bob Phillips]

You're still using ACtivecell. which negates what I suggested. There is no point in changing R.Select to With R and still using Activecell.

As to the point about printer models, that measn nothing to me.

[j.smith1981]

Dont mean to cause an arguement here but I did state that earlier what I mean by printer models being the basis for the categories.

What do you mean remove activecell anyways surely I need to save the value of a cell to a variable and go back, really dont understand how this is going to work.

[Bob Phillips]

I showed you how it works in post #4.

As for the printer models, I know the overall objective, but the phrase ... follow through with all printer models ... is what means nothing to me.

[Paul_Hossler]

j.

Maybe you make a small example workbook with the before and with the desired results?

Paul

[j.smith1981]

I now have an example, details are included on the spreadsheet itself.

I will make another macro of this to show you exactly how it works.

Hope this is aids the development of this macro.

[j.smith1981]

Here's the products file