Help with loops in VBA Array

T

th081

Board Regular
Joined
Mar 26, 2006
Messages
98
Office Version
  1. 365
Platform
  1. Windows
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:

LocationEffective DateTimeStatus
Mod01/12/2019 06:58Online
Mod07/01/2020 15:45Offline
Mod09/01/2020 18:22Online
Mod04/03/2020 00:45No fault
Mod05/03/2020 13:01Offline
Mod04/04/2020 18:52Online
Mod10/04/2020 16:25Offline
Mod12/04/2020 17:36No fault
Mod20/04/2020 06:58Offline
Mod24/04/2020 15:25Online
CVT19/01/2020 18:22No fault
CVT14/03/2020 00:45Online
CVT15/03/2020 13:01No fault
CVT14/05/2020 18:52Offline
CVT11/10/2020 16:25Online
CVT15/10/2020 17:36Offline
CVT21/12/2019 06:58No fault
CVT27/01/2020 15:45Online
CVT29/01/2020 18:22Offline


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
ABCDEFGHI
1Start of half hourEnd of half hourLocationOffline Status in this 30 minMinutes Offline Status (only if Y in Col B)Online Status in this 30minsMinutes Online Status (only if Y in Col D)No Fault Status in this 30 minsMinutes No Fault Status (only if Y in Col H)
201/04/2020 00:0001/04/2020 00:30ModY30N0N0
301/04/2020 00:3001/04/2020 01:00ModY30N0N0
401/04/2020 01:0001/04/2020 01:30ModY30N0N0
501/04/2020 01:3001/04/2020 02:00ModY30N0N0
601/04/2020 02:0001/04/2020 02:30ModY30N0N0
7Deleted a load of cells
8Deleted a load of cells
904/04/2020 14:0004/04/2020 14:30ModY30N0N0
1004/04/2020 14:3004/04/2020 15:00ModY30N0N0
1104/04/2020 15:0004/04/2020 15:30ModY30N0N0
1204/04/2020 15:3004/04/2020 16:00ModY30N0N0
1304/04/2020 16:0004/04/2020 16:30ModY30N0N0
1404/04/2020 16:3004/04/2020 17:00ModY30N0N0
1504/04/2020 17:0004/04/2020 17:30ModY30N0N0
1604/04/2020 17:3004/04/2020 18:00ModY30N0N0
1704/04/2020 18:0004/04/2020 18:30ModY30N0N0
1804/04/2020 18:3004/04/2020 19:00ModY22.00Y8.00N0
1904/04/2020 19:0004/04/2020 19:30ModN0Y30N0
2004/04/2020 19:3004/04/2020 20:00ModN0Y30N0
2104/04/2020 20:0004/04/2020 20:30ModN0Y30N0
2204/04/2020 20:3004/04/2020 21:00ModN0Y30N0
23Deleted a load of cells
24Deleted a load of cells
2510/04/2020 13:0010/04/2020 13:30ModN0Y30N0
2610/04/2020 13:3010/04/2020 14:00ModN0Y30N0
2710/04/2020 14:0010/04/2020 14:30ModN0Y30N0
2810/04/2020 14:3010/04/2020 15:00ModN0Y30N0
2910/04/2020 15:0010/04/2020 15:30ModN0Y30N0
3010/04/2020 15:3010/04/2020 16:00ModN0Y30N0
3110/04/2020 16:0010/04/2020 16:30ModY5.00Y25.00N0
3210/04/2020 16:3010/04/2020 17:00ModY30N0N0
3310/04/2020 17:0010/04/2020 17:30ModY30N0N0
3410/04/2020 17:3010/04/2020 18:00ModY30N0N0
35Deleted a load of cells
36Deleted a load of cells
3712/04/2020 15:3012/04/2020 16:00ModY30N0N0
3812/04/2020 16:0012/04/2020 16:30ModY30N0N0
3912/04/2020 16:3012/04/2020 17:00ModY30N0N0
4012/04/2020 17:0012/04/2020 17:30ModY30N0N0
4112/04/2020 17:3012/04/2020 18:00ModY6N0Y24
4212/04/2020 18:0012/04/2020 18:30ModN0N0Y30
43Deleted a load of cells
44Deleted a load of cells
4520/04/2020 04:3020/04/2020 05:00ModN0N0Y30
4620/04/2020 05:0020/04/2020 05:30ModN0N0Y30
4720/04/2020 05:3020/04/2020 06:00ModN0N0Y30
4820/04/2020 06:0020/04/2020 06:30ModN0N0Y30
4920/04/2020 06:3020/04/2020 07:00Mody2N0Y28
5020/04/2020 07:0020/04/2020 07:30ModY30N0Y0
5120/04/2020 07:3020/04/2020 08:00ModY30N0Y0
5220/04/2020 08:0020/04/2020 08:30ModY30N0Y0
53Deleted a load of cells
54Deleted a load of cells
5524/04/2020 13:0024/04/2020 13:30ModY30N0Y0
5624/04/2020 13:3024/04/2020 14:00ModY30N0Y0
5724/04/2020 14:0024/04/2020 14:30ModY30N0Y0
5824/04/2020 14:3024/04/2020 15:00ModY30N0Y0
5924/04/2020 15:0024/04/2020 15:30ModY25Y5N0
6024/04/2020 15:3024/04/2020 16:00ModN0Y30N0
6124/04/2020 16:0024/04/2020 16:30ModN0Y30N0
6224/04/2020 16:3024/04/2020 17:00ModN0Y30N0
63Deleted a load of cells
64Deleted a load of cells
6531/03/2021 18:3031/03/2021 19:00ModN0Y30N0
6631/03/2021 19:0031/03/2021 19:30ModN0Y30N0
6731/03/2021 19:3031/03/2021 20:00ModN0Y30N0
6831/03/2021 20:0031/03/2021 20:30ModN0Y30N0
6931/03/2021 20:3031/03/2021 21:00ModN0Y30N0
7031/03/2021 21:0031/03/2021 21:30ModN0Y30N0
7131/03/2021 21:3031/03/2021 22:00ModN0Y30N0
7231/03/2021 22:0031/03/2021 22:30ModN0Y30N0
7331/03/2021 22:3031/03/2021 23:00ModN0Y30N0
7431/03/2021 23:0031/03/2021 23:30ModN0Y30N0
7531/03/2021 23:3001/04/2021 00:00ModN0Y30N0
Output Expected
Cell Formulas
RangeFormula
E18E18=('Import Data'!B7-'Output Expected'!A18)*(24*60)
G18G18=(A19-'Import Data'!B7)*(24*60)
E31E31=(A32-'Import Data'!B8)*(24*60)
G31G31=('Import Data'!B8-'Output Expected'!A31)*(24*60)
E41E41=('Import Data'!B9-'Output Expected'!A41)*(24*60)
I41I41=('Output Expected'!B41-'Import Data'!B9)*(24*60)
E49E49=(B49-'Import Data'!B10)*24*60
I49I49=('Import Data'!B10-'Output Expected'!A49)*24*60
E59E59=('Import Data'!B11-'Output Expected'!A59)*24*60
G59G59=(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
ABCDEFGHIJ
1Start Date01/04/2020
2End Date31/03/2021Calculated from start date
3
4
5LocationStatus Prior to Start Date above
6ModOfflineDerived from data in other sheet if no date prior to date above then assume Online
7CVTNo faultDerived from data in other sheet if no date prior to date above then assume Online
8
Parameters
Cell Formulas
RangeFormula
B2B2=TEXT(31&"/"&3&"/"&YEAR(B1)+1,"dd/mm/yyyy")
B6B6='Import Data'!C6
B7B7='Import Data'!C14


Much apprciate any help or even a steer.

Regards

Taz
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
You must log in or register to reply here.

Similar threads

H
  • Solved
Search for topics based on their groups.
Replies
7
Views
139
Peter_SSs
Peter_SSs
muhammad susanto
  • Solved
Concatenate Formula Text & DateTime, Exclude Time
Replies
2
Views
390
muhammad susanto
muhammad susanto
R
  • Solved
Stumped on counting patients unique visits to a clinic
Replies
7
Views
363
Fluff
Fluff
H
  • Solved
Find a subject that is in column "P" in columns "G" and "L" and export.
Replies
2
Views
134
harzer
H
N
  • Question
Marco, IFS and XLOOKUP but certainly happy to be wrong
Replies
2
Views
133
N0t Y0urs
N

Forum statistics

Threads
1,214,864
Messages
6,121,981
Members
449,058
Latest member
oculus

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top