sandero
07-27-2006, 06:13 AM
Hi,
i'm a student, i do a job in a company during this vacation.
I was asked today to write a VBA code in excel that combines data from 3 worksheets, but it has to loop through all records every time he needs something, how to make this code more performant (for 2000 records, it takes 50 minutes!!)
the story is : there are 3 worksheets: products, product-component and animal-microorganisms.
for products, we need to request import licenses for international shipping,
so we need a few attributes of products: product number, where it has been produced (usually USA), and quantity, then the components are searched of that product, in the product - component worksheet. then the ingredients (animals or micro organisms) are added for both products and components
greetz, sander
btw sorry for my bad english
the example file is running the program, and probably will do so for the next hour, and the problem is, my hours are from 8.30 am to 5 pm and 5 pm is in 12 minutes over here :)
tomorrow ill be able to add example file, but it would be great if you look at it allready, cause my job period (wich was a month) ends tomorrow at noon
Sub test()
'define number of records in products
Dim C As Integer
Dim counter As Integer
Dim counter1 As Integer
Dim counter2 As Integer
Dim counter3 As Integer
Dim Value1 As String
Dim Value2 As String
C = Telrecords("Products")
'copy of required product attributes to the other worksheet
Sheet1.Activate
Range(Cells(1, 2), Cells(C, 2)).Copy
Sheet8.Select
Range("A1").PasteSpecial
Sheet1.Activate
Range(Cells(1, 6), Cells(C, 6)).Copy
Sheet8.Select
Range("B1").PasteSpecial
Sheet1.Activate
Range(Cells(1, 9), Cells(C, 11)).Copy
Sheet8.Select
Range("C1").PasteSpecial
Sheet1.Activate
Range(Cells(1, 19), Cells(C, 19)).Copy
Sheet8.Select
Range("F1").PasteSpecial
'end of copy
'testing insert rows
'For counter = 4 To (Telrecords("Sheet1")) * 2 Step 2
'Range(Cells(counter - 1, 1), Cells(counter - 1, 1)).Select
'ActiveCell.EntireRow.Insert shift:=xlUp
'Next
'For counter = 2 To (Telrecords("Products") + Telrecords("Product-Component") + Telrecords("Animal-MicroOrganisms"))
For counter = 20 To 25
'For counter = 2 To C
Value1 = Worksheets("Sheet1").Cells(counter, 1).Value
'insertion of the components and their animal-microorganism values
For counter1 = 1 To Telrecords("Product-Component")
Sheet2.Activate
If ActiveSheet.Cells(counter1, 1).Value = Value1 Then
Sheet8.Activate
Range(Cells(counter + 1, 1), Cells(counter + 1, 1)).Select
ActiveCell.EntireRow.Insert shift:=xlDown
C = C + 1
Sheet2.Activate
Range(Cells(counter1, 2), Cells(counter1, 2)).Copy
Sheet8.Activate
Range(Cells(counter + 1, 7), Cells(counter + 1, 7)).PasteSpecial
Sheet2.Activate
counter = counter + 1
Value2 = Worksheets("Product-Component").Cells(counter1, 2).Value
For counter3 = 1 To Telrecords("Animal-MicroOrganisms")
Sheet3.Activate
If ActiveSheet.Cells(counter3, 1).Value = Value2 Then
Sheet8.Activate
Range(Cells(counter + 1, 1), Cells(counter + 1, 1)).Select
ActiveCell.EntireRow.Insert shift:=xlDown
C = C + 1
Sheet3.Activate
Range(Cells(counter3, 3), Cells(counter3, 5)).Copy
Sheet8.Activate
Range(Cells(counter + 1, 8), Cells(counter + 1, 8)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheet3.Activate
Range(Cells(counter3, 8), Cells(counter3, 9)).Copy
Sheet8.Activate
Range(Cells(counter + 1, 11), Cells(counter + 1, 11)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
counter = counter + 1
End If
Next
End If
Next
'insertion of the animal-microorganism values for the products
For counter2 = 1 To Telrecords("Animal-MicroOrganisms")
Sheet3.Activate
If ActiveSheet.Cells(counter2, 1).Value = Value1 Then
Sheet8.Activate
Range(Cells(counter + 1, 1), Cells(counter + 1, 1)).Select
ActiveCell.EntireRow.Insert shift:=xlDown
C = C + 1
Sheet3.Activate
Range(Cells(counter2, 3), Cells(counter2, 5)).Copy
Sheet8.Activate
Range(Cells(counter + 1, 8), Cells(counter + 1, 8)).PasteSpecial
Sheet3.Activate
Range(Cells(counter2, 8), Cells(counter2, 9)).Copy
Sheet8.Activate
Range(Cells(counter + 1, 11), Cells(counter + 1, 11)).PasteSpecial
counter = counter + 1
End If
Next
Next
End Sub
Function Telrecords(Worksheet As String) As Integer
Dim A As Integer
Dim B As Integer
A = 1
B = 0
Do
If Worksheets(Worksheet).Cells(A, 1) = "" Then
B = 1
Else
A = A + 1
End If
Loop Until B = 1
Telrecords = A
'MsgBox (A)
End Function
i'm a student, i do a job in a company during this vacation.
I was asked today to write a VBA code in excel that combines data from 3 worksheets, but it has to loop through all records every time he needs something, how to make this code more performant (for 2000 records, it takes 50 minutes!!)
the story is : there are 3 worksheets: products, product-component and animal-microorganisms.
for products, we need to request import licenses for international shipping,
so we need a few attributes of products: product number, where it has been produced (usually USA), and quantity, then the components are searched of that product, in the product - component worksheet. then the ingredients (animals or micro organisms) are added for both products and components
greetz, sander
btw sorry for my bad english
the example file is running the program, and probably will do so for the next hour, and the problem is, my hours are from 8.30 am to 5 pm and 5 pm is in 12 minutes over here :)
tomorrow ill be able to add example file, but it would be great if you look at it allready, cause my job period (wich was a month) ends tomorrow at noon
Sub test()
'define number of records in products
Dim C As Integer
Dim counter As Integer
Dim counter1 As Integer
Dim counter2 As Integer
Dim counter3 As Integer
Dim Value1 As String
Dim Value2 As String
C = Telrecords("Products")
'copy of required product attributes to the other worksheet
Sheet1.Activate
Range(Cells(1, 2), Cells(C, 2)).Copy
Sheet8.Select
Range("A1").PasteSpecial
Sheet1.Activate
Range(Cells(1, 6), Cells(C, 6)).Copy
Sheet8.Select
Range("B1").PasteSpecial
Sheet1.Activate
Range(Cells(1, 9), Cells(C, 11)).Copy
Sheet8.Select
Range("C1").PasteSpecial
Sheet1.Activate
Range(Cells(1, 19), Cells(C, 19)).Copy
Sheet8.Select
Range("F1").PasteSpecial
'end of copy
'testing insert rows
'For counter = 4 To (Telrecords("Sheet1")) * 2 Step 2
'Range(Cells(counter - 1, 1), Cells(counter - 1, 1)).Select
'ActiveCell.EntireRow.Insert shift:=xlUp
'Next
'For counter = 2 To (Telrecords("Products") + Telrecords("Product-Component") + Telrecords("Animal-MicroOrganisms"))
For counter = 20 To 25
'For counter = 2 To C
Value1 = Worksheets("Sheet1").Cells(counter, 1).Value
'insertion of the components and their animal-microorganism values
For counter1 = 1 To Telrecords("Product-Component")
Sheet2.Activate
If ActiveSheet.Cells(counter1, 1).Value = Value1 Then
Sheet8.Activate
Range(Cells(counter + 1, 1), Cells(counter + 1, 1)).Select
ActiveCell.EntireRow.Insert shift:=xlDown
C = C + 1
Sheet2.Activate
Range(Cells(counter1, 2), Cells(counter1, 2)).Copy
Sheet8.Activate
Range(Cells(counter + 1, 7), Cells(counter + 1, 7)).PasteSpecial
Sheet2.Activate
counter = counter + 1
Value2 = Worksheets("Product-Component").Cells(counter1, 2).Value
For counter3 = 1 To Telrecords("Animal-MicroOrganisms")
Sheet3.Activate
If ActiveSheet.Cells(counter3, 1).Value = Value2 Then
Sheet8.Activate
Range(Cells(counter + 1, 1), Cells(counter + 1, 1)).Select
ActiveCell.EntireRow.Insert shift:=xlDown
C = C + 1
Sheet3.Activate
Range(Cells(counter3, 3), Cells(counter3, 5)).Copy
Sheet8.Activate
Range(Cells(counter + 1, 8), Cells(counter + 1, 8)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheet3.Activate
Range(Cells(counter3, 8), Cells(counter3, 9)).Copy
Sheet8.Activate
Range(Cells(counter + 1, 11), Cells(counter + 1, 11)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
counter = counter + 1
End If
Next
End If
Next
'insertion of the animal-microorganism values for the products
For counter2 = 1 To Telrecords("Animal-MicroOrganisms")
Sheet3.Activate
If ActiveSheet.Cells(counter2, 1).Value = Value1 Then
Sheet8.Activate
Range(Cells(counter + 1, 1), Cells(counter + 1, 1)).Select
ActiveCell.EntireRow.Insert shift:=xlDown
C = C + 1
Sheet3.Activate
Range(Cells(counter2, 3), Cells(counter2, 5)).Copy
Sheet8.Activate
Range(Cells(counter + 1, 8), Cells(counter + 1, 8)).PasteSpecial
Sheet3.Activate
Range(Cells(counter2, 8), Cells(counter2, 9)).Copy
Sheet8.Activate
Range(Cells(counter + 1, 11), Cells(counter + 1, 11)).PasteSpecial
counter = counter + 1
End If
Next
Next
End Sub
Function Telrecords(Worksheet As String) As Integer
Dim A As Integer
Dim B As Integer
A = 1
B = 0
Do
If Worksheets(Worksheet).Cells(A, 1) = "" Then
B = 1
Else
A = A + 1
End If
Loop Until B = 1
Telrecords = A
'MsgBox (A)
End Function