The problem I'm stuck with is as follows. I'm trying to cut "Price and Date" from an import page into a new table based on numerous criteria. I have a Specification sheet where I compare what those criteria have to be.
On the import page I have 3 criteria that have to be fulfilled first of all (these change based on the users input:
These are compared to a table which looks as follows: (This table doesn't change much. At most Origin and Key might be updated, or another row might be added)
For every line where Fruit, Type and Color match we have to look at another factor. Whether or not the fruit was bought from the "supermarket" or "farmer". On the import sheet we have the following table which changes every month.
When the fruit is bought at the Supermarket I want to use the correct key that corresponds with the row that fulfills the right criteria for "Fruit", "Type" and "Color". So in this example above I would like to use the key that corresponds with "Apple", "Fresh", "Red". Which in this example is just the first row. The corresponding key is "Supermarket ID 1" of which we have several rows of data in the import table. I would like to cut and paste the "Price" and "Date" from these rows into a new table.
For those fruits bought from the farmer it's a little different because 1) The comparable key is in a different column than the supermarket one and 2) The key is just a piece of the whole string of the import page (this is always the case). Here too I would like to cut the "Price" and "Date" into a different table.
Hopefully someone understands the problem. The code I've written so far is as follows:
Sub Fruits1()
Dim Criteria1 As Variant, Criteria2 As Variant, Criteria3 As Variant, Criteria4 As Variant, Criteria5 As Variant
Dim rng As Range, cell As Range
Dim wsImport As Worksheet: Set wsImport = Sheets("Import")
Dim wsSpec As Worksheet: Set wsSpec = Sheets("Specificaties")
Dim primarykey As String, comparingkey As String
Criteria1 = wsImport.Range("C3")
Criteria2 = wsImport.Range("C4")
Criteria3 = wsImport.Range("C5")
Set rng = wsSpec.Range("H3:H" & (wsSpec.Cells(Rows.Count, 8).End(xlUp).Row))
For Each cell In rng
If cell.Value = Criteria1 And cell.Offset(0, 1).Value = Criteria2 And cell.Offset(0, 2).Value = Criteria3 Then
If cell.Offset(0, 3) = "Supermarket" Then
import_lastrow = wsImport.Range("E" & Rows.Count).End(xlUp).Row
For i = import_lastrow To 2 Step -1
primarykey = cell.Offset(0, 4).Value
comparingkey = wsImport.Cells(i, 13).Value
If InStr(primarykey, comparingkey) > 0 Then
MsgBox "cut Price and Data into new table"
End If
Next i
ElseIf cell.Offset(0, 4) = "Farmer" Then
For i = import_lastrow To 2 Step -1
primarykey = cell.Offset(0, 4).Value
comparingkey = wsImport.Cells(i, 8).Value
If InStr(primarykey, comparingkey) > 0 Then
MsgBox "cut Price and Data into new table"
End If
Next i
End If
End If
Next cell
End Sub
The problem I believe lies in that I'm trying to loop through different ranges and not doing it right.
与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…