Macro works as follows:
- We have a program recording values in intervals of 1-120s, data from it is on Sheet2, dynamic data range B:W columns
- User is entering target and deviation value on Sheet3
- On Sheet2, if max value in a row is bigger than "target value minus deviation value" it will start copying rows into table on Sheet1
- In table on Sheet1 values needs to be displayed every 2-min, so macro will copy every X row (depending on intervals)
Macro is working properly but I need to run it 8 times on 8 different target values. Was wondering if anyone have any idea to speed things up
'Cell address with target value"
target = Sheets(3).Cells(93, 2).Value
'Cell address with deviation value"
deviation = Sheets(3).Cells(95, 2).Value
'Calculate time between measurements'
lngRowMultiplier = 120 / Sheets(3).Cells(81, "B").Value
'First row to copy into'
pasteRow = 34
'Row number to search through'
For i = 2 To 8000
'Range to search through'
s_max_value_range = "B" & i & ":W" & i
'Max value in a row'
max_value = Application.WorksheetFunction.Max(Sheets(2).Range(s_max_value_range))
If (Abs(target - max_value) <= deviation) Then
'Copy up to 5 hours or until lowest value in a row will be bigger than target value + deviation'
For j = 1 To 150
'Minimum value in a row'
min_value = Application.WorksheetFunction.Min(Sheets(2).Range("B" & i + (j - 1) * lngRowMultiplier & ":W" & i + (j - 1) * lngRowMultiplier))
If (min_value <= target + deviation) Then
s_copyRange = "B" & i + (j - 1) * lngRowMultiplier & ":W" & i + (j - 1) * lngRowMultiplier
s_pasteRange = "C" & pasteRow & ":V" & pasteRow
'Copy to Sheet1'
Sheets(2).Range(s_copyRange).Copy Destination:=Sheets(1).Range(s_pasteRange)
Sheets(1).Range("B" & pasteRow) = Sheets(2).Range("B" & i + (j - 1) * lngRowMultiplier)
pasteRow = pasteRow + 1
End If
Next j
i = 8001
End If
Next i
All help appreciated
See Question&Answers more detail:os