Hi All,
I am trying to create a VBA Array so i can process a large volume of calculations but am struggling.
I have a data set as below:
I am trying to put into a tabular array how many minutes each category was logged for each half hour in the date range starting from 1st April for a user selected date. I want my output to look something like the following:
In the vba i am first importing the data then trying to create the output sheet in memory for calculation:
Sub ImporttoArray()
Dim FindName(3) As String
Set shtTrg = Sheets("Import Data")
shtTrg.Select
FindName(1) = "Location"
FindName(2) = "Effective DateTime"
FindName(3) = "Status"
With shtTrg
Range("A2").Select
Do Until ActiveCell = 0
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(-1, 0).Select
Edadre = ActiveCell.Address
End With
'find the column on the sheet
For i = 1 To 3
FindW = FindName(i)
Set Rng = Cells.Find(What:=FindW, After:=ActiveCell, LookIn:=xlFormulas, _
Lookat:=xlPart, SEarchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)
If Rng Is Nothing Then
MsgBox "Check Data"
Exit Sub
End If
Rng.Select
staddress = ActiveCell.Address
Selection.End(xlDown).Select
endaddress = ActiveCell.Address
If i = 1 Then rw = ActiveCell.Row
If i <> 1 Then cw = ActiveCell.Column
If i <> 1 Then cw = endaddress = Cells(rw, cw).Address
Select Case i
Case 1
Location_A = Range(staddress, Edadre)
Case 2
DateTime_B = Range(staddress, endaddress)
Case 3
Status_C = Range(staddress, endaddress)
End Select
Next i
'Stop
End Sub
Sub Output()
Set shtTrg = Sheets("Output Expected")
shtTrg.Select
StartDate = DateValue(Sheets("Parameters").Range("B1").Value)
EndDate = DateValue(Sheets("Parameters").Range("B2").Value)
'30 min periods between dates
Duration = ((EndDate - StartDate + (1)) * 24 * 2) - 1
ReDim MyArraydatestart(Duration) As Variant
ReDim MyArraydateend(Duration) As Variant
MyArraydatestart(0) = StartDate
MyArraydateend(0) = DateAdd("n", 30, MyArraydatestart(0))
For k = 1 To Duration
MyArraydatestart(k) = DateAdd("n", 30, MyArraydatestart(k - 1))
MyArraydateend(k) = DateAdd("n", 30, MyArraydatestart(k))
Next k
For i = 0 To Duration
Cells(i + 2, 1).Value = MyArraydatestart(i)
Cells(i + 2, 2).Value = MyArraydateend(i)
Next i
End Sub
Can anyone provide some help please. the other sheet i use is the one the user will enter the start date
Much apprciate any help or even a steer.
Regards
Taz
I am trying to create a VBA Array so i can process a large volume of calculations but am struggling.
I have a data set as below:
Location | Effective DateTime | Status |
Mod | 01/12/2019 06:58 | Online |
Mod | 07/01/2020 15:45 | Offline |
Mod | 09/01/2020 18:22 | Online |
Mod | 04/03/2020 00:45 | No fault |
Mod | 05/03/2020 13:01 | Offline |
Mod | 04/04/2020 18:52 | Online |
Mod | 10/04/2020 16:25 | Offline |
Mod | 12/04/2020 17:36 | No fault |
Mod | 20/04/2020 06:58 | Offline |
Mod | 24/04/2020 15:25 | Online |
CVT | 19/01/2020 18:22 | No fault |
CVT | 14/03/2020 00:45 | Online |
CVT | 15/03/2020 13:01 | No fault |
CVT | 14/05/2020 18:52 | Offline |
CVT | 11/10/2020 16:25 | Online |
CVT | 15/10/2020 17:36 | Offline |
CVT | 21/12/2019 06:58 | No fault |
CVT | 27/01/2020 15:45 | Online |
CVT | 29/01/2020 18:22 | Offline |
I am trying to put into a tabular array how many minutes each category was logged for each half hour in the date range starting from 1st April for a user selected date. I want my output to look something like the following:
Sample.xlsm | |||||||||||
---|---|---|---|---|---|---|---|---|---|---|---|
A | B | C | D | E | F | G | H | I | |||
1 | Start of half hour | End of half hour | Location | Offline Status in this 30 min | Minutes Offline Status (only if Y in Col B) | Online Status in this 30mins | Minutes Online Status (only if Y in Col D) | No Fault Status in this 30 mins | Minutes No Fault Status (only if Y in Col H) | ||
2 | 01/04/2020 00:00 | 01/04/2020 00:30 | Mod | Y | 30 | N | 0 | N | 0 | ||
3 | 01/04/2020 00:30 | 01/04/2020 01:00 | Mod | Y | 30 | N | 0 | N | 0 | ||
4 | 01/04/2020 01:00 | 01/04/2020 01:30 | Mod | Y | 30 | N | 0 | N | 0 | ||
5 | 01/04/2020 01:30 | 01/04/2020 02:00 | Mod | Y | 30 | N | 0 | N | 0 | ||
6 | 01/04/2020 02:00 | 01/04/2020 02:30 | Mod | Y | 30 | N | 0 | N | 0 | ||
7 | Deleted a load of cells | ||||||||||
8 | Deleted a load of cells | ||||||||||
9 | 04/04/2020 14:00 | 04/04/2020 14:30 | Mod | Y | 30 | N | 0 | N | 0 | ||
10 | 04/04/2020 14:30 | 04/04/2020 15:00 | Mod | Y | 30 | N | 0 | N | 0 | ||
11 | 04/04/2020 15:00 | 04/04/2020 15:30 | Mod | Y | 30 | N | 0 | N | 0 | ||
12 | 04/04/2020 15:30 | 04/04/2020 16:00 | Mod | Y | 30 | N | 0 | N | 0 | ||
13 | 04/04/2020 16:00 | 04/04/2020 16:30 | Mod | Y | 30 | N | 0 | N | 0 | ||
14 | 04/04/2020 16:30 | 04/04/2020 17:00 | Mod | Y | 30 | N | 0 | N | 0 | ||
15 | 04/04/2020 17:00 | 04/04/2020 17:30 | Mod | Y | 30 | N | 0 | N | 0 | ||
16 | 04/04/2020 17:30 | 04/04/2020 18:00 | Mod | Y | 30 | N | 0 | N | 0 | ||
17 | 04/04/2020 18:00 | 04/04/2020 18:30 | Mod | Y | 30 | N | 0 | N | 0 | ||
18 | 04/04/2020 18:30 | 04/04/2020 19:00 | Mod | Y | 22.00 | Y | 8.00 | N | 0 | ||
19 | 04/04/2020 19:00 | 04/04/2020 19:30 | Mod | N | 0 | Y | 30 | N | 0 | ||
20 | 04/04/2020 19:30 | 04/04/2020 20:00 | Mod | N | 0 | Y | 30 | N | 0 | ||
21 | 04/04/2020 20:00 | 04/04/2020 20:30 | Mod | N | 0 | Y | 30 | N | 0 | ||
22 | 04/04/2020 20:30 | 04/04/2020 21:00 | Mod | N | 0 | Y | 30 | N | 0 | ||
23 | Deleted a load of cells | ||||||||||
24 | Deleted a load of cells | ||||||||||
25 | 10/04/2020 13:00 | 10/04/2020 13:30 | Mod | N | 0 | Y | 30 | N | 0 | ||
26 | 10/04/2020 13:30 | 10/04/2020 14:00 | Mod | N | 0 | Y | 30 | N | 0 | ||
27 | 10/04/2020 14:00 | 10/04/2020 14:30 | Mod | N | 0 | Y | 30 | N | 0 | ||
28 | 10/04/2020 14:30 | 10/04/2020 15:00 | Mod | N | 0 | Y | 30 | N | 0 | ||
29 | 10/04/2020 15:00 | 10/04/2020 15:30 | Mod | N | 0 | Y | 30 | N | 0 | ||
30 | 10/04/2020 15:30 | 10/04/2020 16:00 | Mod | N | 0 | Y | 30 | N | 0 | ||
31 | 10/04/2020 16:00 | 10/04/2020 16:30 | Mod | Y | 5.00 | Y | 25.00 | N | 0 | ||
32 | 10/04/2020 16:30 | 10/04/2020 17:00 | Mod | Y | 30 | N | 0 | N | 0 | ||
33 | 10/04/2020 17:00 | 10/04/2020 17:30 | Mod | Y | 30 | N | 0 | N | 0 | ||
34 | 10/04/2020 17:30 | 10/04/2020 18:00 | Mod | Y | 30 | N | 0 | N | 0 | ||
35 | Deleted a load of cells | ||||||||||
36 | Deleted a load of cells | ||||||||||
37 | 12/04/2020 15:30 | 12/04/2020 16:00 | Mod | Y | 30 | N | 0 | N | 0 | ||
38 | 12/04/2020 16:00 | 12/04/2020 16:30 | Mod | Y | 30 | N | 0 | N | 0 | ||
39 | 12/04/2020 16:30 | 12/04/2020 17:00 | Mod | Y | 30 | N | 0 | N | 0 | ||
40 | 12/04/2020 17:00 | 12/04/2020 17:30 | Mod | Y | 30 | N | 0 | N | 0 | ||
41 | 12/04/2020 17:30 | 12/04/2020 18:00 | Mod | Y | 6 | N | 0 | Y | 24 | ||
42 | 12/04/2020 18:00 | 12/04/2020 18:30 | Mod | N | 0 | N | 0 | Y | 30 | ||
43 | Deleted a load of cells | ||||||||||
44 | Deleted a load of cells | ||||||||||
45 | 20/04/2020 04:30 | 20/04/2020 05:00 | Mod | N | 0 | N | 0 | Y | 30 | ||
46 | 20/04/2020 05:00 | 20/04/2020 05:30 | Mod | N | 0 | N | 0 | Y | 30 | ||
47 | 20/04/2020 05:30 | 20/04/2020 06:00 | Mod | N | 0 | N | 0 | Y | 30 | ||
48 | 20/04/2020 06:00 | 20/04/2020 06:30 | Mod | N | 0 | N | 0 | Y | 30 | ||
49 | 20/04/2020 06:30 | 20/04/2020 07:00 | Mod | y | 2 | N | 0 | Y | 28 | ||
50 | 20/04/2020 07:00 | 20/04/2020 07:30 | Mod | Y | 30 | N | 0 | Y | 0 | ||
51 | 20/04/2020 07:30 | 20/04/2020 08:00 | Mod | Y | 30 | N | 0 | Y | 0 | ||
52 | 20/04/2020 08:00 | 20/04/2020 08:30 | Mod | Y | 30 | N | 0 | Y | 0 | ||
53 | Deleted a load of cells | ||||||||||
54 | Deleted a load of cells | ||||||||||
55 | 24/04/2020 13:00 | 24/04/2020 13:30 | Mod | Y | 30 | N | 0 | Y | 0 | ||
56 | 24/04/2020 13:30 | 24/04/2020 14:00 | Mod | Y | 30 | N | 0 | Y | 0 | ||
57 | 24/04/2020 14:00 | 24/04/2020 14:30 | Mod | Y | 30 | N | 0 | Y | 0 | ||
58 | 24/04/2020 14:30 | 24/04/2020 15:00 | Mod | Y | 30 | N | 0 | Y | 0 | ||
59 | 24/04/2020 15:00 | 24/04/2020 15:30 | Mod | Y | 25 | Y | 5 | N | 0 | ||
60 | 24/04/2020 15:30 | 24/04/2020 16:00 | Mod | N | 0 | Y | 30 | N | 0 | ||
61 | 24/04/2020 16:00 | 24/04/2020 16:30 | Mod | N | 0 | Y | 30 | N | 0 | ||
62 | 24/04/2020 16:30 | 24/04/2020 17:00 | Mod | N | 0 | Y | 30 | N | 0 | ||
63 | Deleted a load of cells | ||||||||||
64 | Deleted a load of cells | ||||||||||
65 | 31/03/2021 18:30 | 31/03/2021 19:00 | Mod | N | 0 | Y | 30 | N | 0 | ||
66 | 31/03/2021 19:00 | 31/03/2021 19:30 | Mod | N | 0 | Y | 30 | N | 0 | ||
67 | 31/03/2021 19:30 | 31/03/2021 20:00 | Mod | N | 0 | Y | 30 | N | 0 | ||
68 | 31/03/2021 20:00 | 31/03/2021 20:30 | Mod | N | 0 | Y | 30 | N | 0 | ||
69 | 31/03/2021 20:30 | 31/03/2021 21:00 | Mod | N | 0 | Y | 30 | N | 0 | ||
70 | 31/03/2021 21:00 | 31/03/2021 21:30 | Mod | N | 0 | Y | 30 | N | 0 | ||
71 | 31/03/2021 21:30 | 31/03/2021 22:00 | Mod | N | 0 | Y | 30 | N | 0 | ||
72 | 31/03/2021 22:00 | 31/03/2021 22:30 | Mod | N | 0 | Y | 30 | N | 0 | ||
73 | 31/03/2021 22:30 | 31/03/2021 23:00 | Mod | N | 0 | Y | 30 | N | 0 | ||
74 | 31/03/2021 23:00 | 31/03/2021 23:30 | Mod | N | 0 | Y | 30 | N | 0 | ||
75 | 31/03/2021 23:30 | 01/04/2021 00:00 | Mod | N | 0 | Y | 30 | N | 0 | ||
Output Expected |
Cell Formulas | ||
---|---|---|
Range | Formula | |
E18 | E18 | =('Import Data'!B7-'Output Expected'!A18)*(24*60) |
G18 | G18 | =(A19-'Import Data'!B7)*(24*60) |
E31 | E31 | =(A32-'Import Data'!B8)*(24*60) |
G31 | G31 | =('Import Data'!B8-'Output Expected'!A31)*(24*60) |
E41 | E41 | =('Import Data'!B9-'Output Expected'!A41)*(24*60) |
I41 | I41 | =('Output Expected'!B41-'Import Data'!B9)*(24*60) |
E49 | E49 | =(B49-'Import Data'!B10)*24*60 |
I49 | I49 | =('Import Data'!B10-'Output Expected'!A49)*24*60 |
E59 | E59 | =('Import Data'!B11-'Output Expected'!A59)*24*60 |
G59 | G59 | =(B59-'Import Data'!B11)*24*60 |
In the vba i am first importing the data then trying to create the output sheet in memory for calculation:
Sub ImporttoArray()
Dim FindName(3) As String
Set shtTrg = Sheets("Import Data")
shtTrg.Select
FindName(1) = "Location"
FindName(2) = "Effective DateTime"
FindName(3) = "Status"
With shtTrg
Range("A2").Select
Do Until ActiveCell = 0
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(-1, 0).Select
Edadre = ActiveCell.Address
End With
'find the column on the sheet
For i = 1 To 3
FindW = FindName(i)
Set Rng = Cells.Find(What:=FindW, After:=ActiveCell, LookIn:=xlFormulas, _
Lookat:=xlPart, SEarchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)
If Rng Is Nothing Then
MsgBox "Check Data"
Exit Sub
End If
Rng.Select
staddress = ActiveCell.Address
Selection.End(xlDown).Select
endaddress = ActiveCell.Address
If i = 1 Then rw = ActiveCell.Row
If i <> 1 Then cw = ActiveCell.Column
If i <> 1 Then cw = endaddress = Cells(rw, cw).Address
Select Case i
Case 1
Location_A = Range(staddress, Edadre)
Case 2
DateTime_B = Range(staddress, endaddress)
Case 3
Status_C = Range(staddress, endaddress)
End Select
Next i
'Stop
End Sub
Sub Output()
Set shtTrg = Sheets("Output Expected")
shtTrg.Select
StartDate = DateValue(Sheets("Parameters").Range("B1").Value)
EndDate = DateValue(Sheets("Parameters").Range("B2").Value)
'30 min periods between dates
Duration = ((EndDate - StartDate + (1)) * 24 * 2) - 1
ReDim MyArraydatestart(Duration) As Variant
ReDim MyArraydateend(Duration) As Variant
MyArraydatestart(0) = StartDate
MyArraydateend(0) = DateAdd("n", 30, MyArraydatestart(0))
For k = 1 To Duration
MyArraydatestart(k) = DateAdd("n", 30, MyArraydatestart(k - 1))
MyArraydateend(k) = DateAdd("n", 30, MyArraydatestart(k))
Next k
For i = 0 To Duration
Cells(i + 2, 1).Value = MyArraydatestart(i)
Cells(i + 2, 2).Value = MyArraydateend(i)
Next i
End Sub
Can anyone provide some help please. the other sheet i use is the one the user will enter the start date
Sample.xlsm | ||||||||||||
---|---|---|---|---|---|---|---|---|---|---|---|---|
A | B | C | D | E | F | G | H | I | J | |||
1 | Start Date | 01/04/2020 | ||||||||||
2 | End Date | 31/03/2021 | Calculated from start date | |||||||||
3 | ||||||||||||
4 | ||||||||||||
5 | Location | Status Prior to Start Date above | ||||||||||
6 | Mod | Offline | Derived from data in other sheet if no date prior to date above then assume Online | |||||||||
7 | CVT | No fault | Derived from data in other sheet if no date prior to date above then assume Online | |||||||||
8 | ||||||||||||
Parameters |
Cell Formulas | ||
---|---|---|
Range | Formula | |
B2 | B2 | =TEXT(31&"/"&3&"/"&YEAR(B1)+1,"dd/mm/yyyy") |
B6 | B6 | ='Import Data'!C6 |
B7 | B7 | ='Import Data'!C14 |
Much apprciate any help or even a steer.
Regards
Taz