I've got a set of data from a database imported into an Excel file. This data is from a laser cutter machine for metal. The data I have includes material name, plate thickness and 2 different times (There's more data but those 4 are the ones I need).
The result I want: I want to filter my data on material name first, after that I want to filter my data on plate thickness. In the results of this second filter I want to SUM the time of both timefields and then post the outcome of this in another sheet. So the result in the second sheet should be: Material name, plate thickness, total time of the results in column D, total time of the results in Column E (There is some data in other columns which is irrelevant for this)
Here's a small example of what the data looks like (Data starts on row 3):
Material name(col A)Plate Thickness(col B)Time1(col D)Time2(col E)
RVS 304 25mm 00:18:14 00:21:48
RVS 304 25mm 00:30:28 00:39:19
RVS 304 10mm 00:12:10 00:14:25
S235 10mm 00:48:32 00:13:33
S235 3mm 00:10:31 00:02:22
Some other useful information: The Material name my loop is based on is based on my results and filtered on duplicates, so the material name always exists. Plate thickness has a standard amount of items the amount of items in this range is 19 different sizes in millimeters. My lists of filter criteria start on Cell 2, that's why the integer starts from 2 aswell. The result of both autofilters can result in nothing, as not every material name has done every plate thickness.
Something to add on my current code: It almost does the job, alltho it skips some items in the loop through the list of material names and it can't sum up the time. It is also extremely slow so I would like to know if I could make it run faster.
This is my code:
Sub TestSub()
On Error Resume Next
Worksheets("InformatieData").ShowAllData
On Error GoTo 0
Dim iLoop As Integer
For iLoop = 1 To 20
Worksheets("InformatieData").Range("A2").AutoFilter Field:=1, Criteria1:=Worksheets("InformatieFormules").Cells(iLoop, 1).Value
If Worksheets("InformatieData").AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
Dim mmLoop As Integer
For mmLoop = 2 To 20
Worksheets("InformatieData").Range("A2").AutoFilter Field:=2, Criteria1:=Worksheets("InformatieFormules").Cells(mmLoop, 2).Value
If Worksheets("InformatieData").AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
Worksheets("InformatieData").Range("A3:A10000,B3:B10000,D3:D10000,E3:E10000").Copy
Worksheets("InformatieMMFilterResultaat").Cells(Cells.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
End If
Next mmLoop
End If
Next iLoop
End Sub
Couldn't test this, but I think it should work, at least until the splitting part (if something goes wrong you could find another way, or just use the interface option for texto to columns):
Option Explicit
Sub Test()
Dim wsData As Worksheet, wsOutput As Worksheet, arrData As Variant, SplitRange As Range, i As Long
'You will need to check Microsoft Scripting Dictionary from your references for this to work:
Dim DictColD As New Scripting.Dictionary, DictColE As New Scripting.Dictionary
'Set the worksheets where we will work
With ThisWorkbook
Set wsData = .Sheets("InformatieData")
Set wsOutput = .Sheets("InformatieMMFilterResultaat")
End With
'Fill an array with the source data
arrData = wsData.UsedRange.Value 'this will get everything on the worksheet till the last used cell
'Lets assume, as you said that the order and position of the columns is A to E
For i = 2 To UBound(arrData) '2 because 1 is headers
'if the material with the thickness doesn't exist yet, add it along with its time on column D
If Not DictColD.Exists(arrData(i, 1) & "-" & arrData(i, 2)) Then
DictColD.Add arrData(i, 1) & "-" & arrData(i, 2), arrData(i, 4) 'Column D value
Else
'If the material with the thickness already exists, then sum its time on column D
DictColD(arrData(i, 1) & "-" & arrData(i, 2)) = DictColD(arrData(i, 1) & "-" & arrData(i, 2)) + arrData(i, 4)
End If
'Now the same for column E
'if the material with the thickness doesn't exist yet, add it along with its time on column E
If Not DictColE.Exists(arrData(i, 1) & "-" & arrData(i, 2)) Then
DictColE.Add arrData(i, 1) & "-" & arrData(i, 2), arrData(i, 5) 'Column E value
Else
'If the material with the thickness already exists, then sum its time on column E
DictColE(arrData(i, 1) & "-" & arrData(i, 2)) = DictColE(arrData(i, 1) & "-" & arrData(i, 2)) + arrData(i, 5)
End If
Next i
Erase arrData
'Now you've got 2 dictionaries along with all the data you need, you only need to throw it back to your sheet
With wsOutput 'I'm going to assume you already have the headers there so only the data will be pasted
.Cells(2, 1).Resize(DictColD.Count) = Application.Transpose(DictColD.Keys) 'Material & Thickness
.Cells(2, 4).Resize(DictColD.Count) = Application.Transpose(DictColD.Items) 'Col D Times
.Cells(2, 5).Resize(DictColE.Count) = Application.Transpose(DictColE.Items) 'Col E Times
'Now we need to separate material & thickness into 2 columns
Set SplitRange = .Range("A2", .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1))
SplitRange.TextToColumns Destination:=SplitRange, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="-", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
End With
End Sub
This should be fairly faster than your actual code since it's working everything on memory.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.