I have a code that uses excel web queries to retrieve data from a web site.
The query part is optimized but the rest of the code with a lot of If statements makes it run slow.
Please help.
Here is the code:
The query part is optimized but the rest of the code with a lot of If statements makes it run slow.
Please help.
Here is the code:
Code:
Sub datta()
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = True
Dim RowNo, lastRowNo As Long
Dim emptyRow As Integer
Dim pageNo, lastPageNo As Integer
Dim rowcount As Integer
Dim lastrow, lastrowQuery As Long
Dim url As String
Dim rezultat() As Variant
Dim pocetak_nutrition As Long
Dim serving_size, Serving_per_Container, Calories, Calories_from_fat, Total_Fat, Saturated_Fat, _
Trans_Fat, Cholesterol, Sodium, Total_Carbohydrate, Fiber, Sugars, Protein, Vitamin_A, Calcium, category As String
Dim product_name, sku, description, origin, ingredients As String
Dim Total_FatPercent, Saturated_FatPercent, Cholesterol_percent, Sodium_percent, Total_Carbohydrate_perce, _
Fiber_perce, Vitamin_A_perce, Calcium_perce As String
lastrow = Sheet7.Range("a2").End(xlDown).Row
Dim skup_linkova() As Variant
skup_linkova = Sheet7.Range("a2:a4740")
For pageNo = 852 To UBound(skup_linkova) 'lastrow
serving_size = vbNullString
Serving_per_Container = vbNullString
Calcium = vbNullString
Calcium_perce = vbNullString
Calories = vbNullString
Calories_from_fat = vbNullString
Total_Carbohydrate = vbNullString
Total_Carbohydrate_perce = vbNullString
Total_Fat = vbNullString
Total_FatPercent = vbNullString
Trans_Fat = vbNullString
Fiber = vbNullString
Fiber_perce = vbNullString
Cholesterol = vbNullString
Cholesterol_percent = vbNullString
ingredients = vbNullString
product_name = vbNullString
sku = vbNullString
origin = vbNullString
category = vbNullString
description = vbNullString
Vitamin_A = vbNullString
Vitamin_A_perce = vbNullString
Sodium = vbNullString
Sodium_percent = vbNullString
Saturated_Fat = vbNullString
Saturated_FatPercent = vbNullString
Sugars = vbNullString
Protein = vbNullString
url = skup_linkova(pageNo, 1) 'Sheet7.Cells(pageNo, 1)
'Application.Wait (Now + TimeValue("0:00:02"))
Call Macro6(url)
lastrowQuery = Sheet5.Cells.SpecialCells(xlCellTypeLastCell).Row
product_name = CStr(Sheet5.Cells(115, 1).Value)
sku = CStr(Sheet5.Cells(116, 1).Value)
description = CStr(Sheet5.Cells(117, 1).Value)
For i = lastrowQuery To 117 Step -1
If InStr(1, Sheet5.Cells(i, 1).Value, "Country of Origin:") > 0 Then
origin = CStr(Replace(Sheet5.Cells(i, 1).Value, "Country of Origin:", ""))
End If
If ingredients = "" Then
If Sheet5.Cells(i, 1).Value = "Ingredients" And Len(Sheet5.Cells(i + 2, 1).Value) > 80 Then
ingredients = CStr(Sheet5.Cells(i + 2, 1).Value)
End If
End If
'nutritions
If serving_size = "" Then
If InStr(1, Sheet5.Cells(i, 1).Value, "Serving Size ") > 0 And InStr(1, Sheet5.Cells(i, 1).Value, "Ingredients") = 0 Then
serving_size = Replace(CStr(Sheet5.Cells(i, 1).Value), "Serving Size", "")
End If
End If
If Serving_per_Container = "" Then
If InStr(1, Sheet5.Cells(i, 1).Value, "Servings per Container") > 0 And InStr(1, Sheet5.Cells(i, 1).Value, "Ingredients") = 0 Then
Serving_per_Container = Replace(CStr(Sheet5.Cells(i, 1).Value), "Servings per Container", "")
End If
End If
If Calories = "" Then
If InStr(1, Sheet5.Cells(i, 1).Value, "Calories") > 0 And InStr(1, Sheet5.Cells(i, 1).Value, "Ingredients") = 0 Then
Calories = Replace(CStr(Sheet5.Cells(i, 1).Value), "Calories", "")
Calories_from_fat = Replace(CStr(Sheet5.Cells(i, 3).Value), "Calories from Fat", "")
End If
End If
If Total_Fat = "" Then
If InStr(1, Sheet5.Cells(i, 1).Value, "Total Fat") > 0 And InStr(1, Sheet5.Cells(i, 1).Value, "Ingredients") = 0 Then
Total_Fat = Replace(CStr(Sheet5.Cells(i, 1).Value), "Total Fat ", "")
Total_FatPercent = CStr(Sheet5.Cells(i, 3).Value)
End If
End If
If Saturated_Fat = "" Then
If InStr(1, Sheet5.Cells(i, 1).Value, "Saturated Fat") > 0 And InStr(1, Sheet5.Cells(i, 1).Value, "Ingredients") = 0 Then
Saturated_Fat = Replace(CStr(Sheet5.Cells(i, 1).Value), "Saturated Fat ", "")
Saturated_FatPercent = CStr(Sheet5.Cells(i, 3).Value)
End If
End If
If Trans_Fat = "" Then
If InStr(1, Sheet5.Cells(i, 1).Value, "Trans Fat ") > 0 And InStr(1, Sheet5.Cells(i, 1).Value, "Ingredients") = 0 Then
Trans_Fat = Replace(CStr(Sheet5.Cells(i, 1).Value), "Trans Fat ", "")
End If
End If
If Cholesterol = "" Then
If InStr(1, Sheet5.Cells(i, 1).Value, "Cholesterol") > 0 And InStr(1, Sheet5.Cells(i, 1).Value, "Ingredients") = 0 Then
Cholesterol = Replace(CStr(Sheet5.Cells(i, 1).Value), "Cholesterol", "")
Cholesterol_percent = CStr(Sheet5.Cells(i, 3).Value)
End If
End If
If Sodium = "" Then
If InStr(1, Sheet5.Cells(i + 3, 1).Value, "Sodium ") > 0 And InStr(1, Sheet5.Cells(i + 3, 1).Value, "Ingredients") = 0 Then
Sodium = Replace(CStr(Sheet5.Cells(i + 3, 1).Value), "Sodium", "")
Sodium_percent = CStr(Sheet5.Cells(i + 3, 3).Value)
End If
End If
If Total_Carbohydrate = "" Then
If InStr(1, Sheet5.Cells(i, 1).Value, "Total Carbohydrate ") > 0 And InStr(1, Sheet5.Cells(i, 1).Value, "Ingredients") = 0 Then
Total_Carbohydrate = Replace(CStr(Sheet5.Cells(i, 1).Value), "Total Carbohydrate ", "")
Total_Carbohydrate_perce = CStr(Sheet5.Cells(i, 3).Value)
End If
End If
If Fiber = "" Then
If InStr(1, Sheet5.Cells(i, 1).Value, "Fiber") > 0 And InStr(1, Sheet5.Cells(i, 1).Value, "Ingredients") = 0 Then
Fiber = Replace(CStr(Sheet5.Cells(i, 1).Value), "Fiber", "")
Fiber_perce = CStr(Sheet5.Cells(i, 3).Value)
End If
End If
If Sugars = "" Then
If InStr(1, Sheet5.Cells(i, 1).Value, "Sugars ") > 0 And InStr(1, Sheet5.Cells(i, 1).Value, "Ingredients") = 0 Then
Sugars = Replace(CStr(Sheet5.Cells(i, 1).Value), "Sugars ", "")
' Fiber_perce = CStr(Sheet5.Cells(i, 3).Value)
End If
End If
If Protein = "" Then
If InStr(1, Sheet5.Cells(i, 1).Value, "Protein ") > 0 And InStr(1, Sheet5.Cells(i, 1).Value, "Ingredients") = 0 Then
Protein = Replace(CStr(Sheet5.Cells(i, 1).Value), "Protein ", "")
' Fiber_perce = CStr(Sheet5.Cells(i, 3).Value)
End If
End If
If Vitamin_A = "" Then
If InStr(1, Sheet5.Cells(i, 1).Value, "Vitamin A") > 0 And InStr(1, Sheet5.Cells(i, 1).Value, "Ingredients") = 0 Then
Vitamin_A = Replace(CStr(Sheet5.Cells(i, 1).Value), "Vitamin A", "")
Vitamin_A_perce = Replace(CStr(Sheet5.Cells(i, 3).Value), "Vitamin C", "")
End If
End If
If Calcium = "" Then
If InStr(1, Sheet5.Cells(i, 1).Value, "Calcium ") > 0 And InStr(1, Sheet5.Cells(i, 1).Value, "Ingredients") = 0 Then
Calcium = Replace(CStr(Sheet5.Cells(i, 1).Value), "Calcium ", "")
Calcium_perce = Replace(CStr(Sheet5.Cells(i, 3).Value), "Iron ", "")
End If
End If
Next
If product_name = "" Then
product_name = vbNullString
ElseIf sku = "" Then
sku = vbNullString
ElseIf description = "" Then
description = vbNullString
ElseIf origin = "" Then
origin = vbNullString
ElseIf ingredients = "" Then
ingredients = ""
End If
category = Mid(url, 41, GetPositionOfFirstNumericCharacter(url) - 41)
rezultat = Array(category, product_name, sku, description, origin, ingredients, serving_size, Serving_per_Container, Calories, Calories_from_fat, Total_Fat, Total_FatPercent, Saturated_Fat, Saturated_FatPercent, Cholesterol, Cholesterol_percent, Sodium, Sodium_percent, Total_Carbohydrate, Total_Carbohydrate_perce, Fiber, Fiber_perce, Sugars, Protein, Vitamin_A, Vitamin_A_perce, Calcium, Calcium_perce)
emptyRow = pageNo
Sheet4.Range("a" & emptyRow & ":ab" & emptyRow) = rezultat
Call brisi_query
'Exit Sub
Next pageNo
' Sheet7.Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
lastrowDATA = Sheet7.Range("a2").End(xlDown).Row
Sheet7.Range("$A$1:$B$" & lastrowDATA).RemoveDuplicates Columns:=Array(1, 2), _
Header:=xlYes
'Range("A21").Select
'On Error Resume Next
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Public Function GetPositionOfFirstNumericCharacter(ByVal s As String) As Integer
For i = 1 To Len(s)
Dim currentCharacter As String
currentCharacter = Mid(s, i, 1)
If IsNumeric(currentCharacter) = True Then
GetPositionOfFirstNumericCharacter = i
Exit Function
End If
Next i
End Function
