Efficient sorting of data with VBA with 3 criteria

[Darthrocket]

Hi Mr. Excel.

I am in the process of automating some stuff at work, and therefore I would like to sort some data with VBA, based on 3 criteria.

I would like so sort some data like seen below:

The way I am doing it now is like the following code:

Range("G7").Select
    Selection.FormulaArray = "=INDEX($E$7:$E$" & LastRow & ",MATCH($G7&H$6&$G$6, $D$7:$D$" & LastRow & "&$B$7:$B$" & LastRow & "&$C$7:$C$" & LastRow & ",0))"
    Selection.AutoFill Destination:=Range("G7:F" & LastRow2)

However this is terribly inefficient, and takes forever to calculate.

Unfortunately my VBA skill are not good enough yet, to figure out a solution, so I hope that you can help me.

Thanks!

 

[Kenneth Hobson]

Since Sample place is the first sort, I don't see how you deal with the next Sample place.

 

[Darthrocket]

Maybe I should have mentioned it, but first I sort for unique batchnumbers:

Range("D7:D" & LastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
        "G7"), Unique:=True

Then I use the following formula (I will insert the names to hopefully make it easier to read): {=INDEX(Values, MATCH(Batchnumber&Impurity&SamplePlace;Batchnumber_range&Impurity_range&SamplePlace_range;0))}

Then I copy this formula down.

For now I am only interested in sample place 1.

 

[Darthrocket]

For anyone interested, I came up with the following solution, that is somewhat quicker. Note the cellrefenrences may not align with the example I posted above.

Option Explicit

Sub FilterUniqueBatchnumber()
Dim LastRowFrom As Long


LastRowFrom = ThisWorkbook.Worksheets("Data").Range("C1").End(xlDown).Row


Range("C1:C" & LastRowFrom).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
        "L1"), Unique:=True
        
End Sub

Sub Sort(ImpurityColumn As Variant)

Dim i As Long
Dim j As Long
Dim LastRow As Long

LastRow = ThisWorkbook.Worksheets("Data").Range("C1").End(xlDown).Row

j = 2
For i = 2 To LastRow

    If Range("A" & i) = Range(ImpurityColumn & "1") And Range("E" & i) = Range("K2") And Range("C" & i) = Range("L" & j) Then
    
    Range(ImpurityColumn & j) = Range("B" & i)
    j = j + 1
    End If

Next i
End Sub

Sub RunSort()

FilterUniqueBatchnumber

Call Sort("M")
Call Sort("O")

End Sub

Still any improvements are welcome!