Looping to Collect Labels and Calculations

Programming Goal:

1) Loop and store individual stats:

a. Scan for Serial Number, offset and collect the following for each:
i. PL#

ii. Firmware version

iii. Capacity (whatever is in cell below)

iv. Technology (whatever is in cell below)

v. Battery #

For each individual PL, the following calculations...

vi. Avg, Min, Max(* % State of Charge)

vii. Avg, Min, Max(Temp)

viii. Min, Max, Avg(I start of charge (A))

ix. Number of occurrences Equal. Time at “=0”,”(1,419)”,”(420,839)”,”=840”

x. Number of occurrences Low Level “yes” and “no”

xi. Ratio of yes/(yes+no)

xii. Sum(Disch. Ah-)

xiii. Sum(Ah+ Charge)

xiv. Ratio of (Ah+ / Ah-)

2) Output table to a new sheet:

a. Create table with headers respective i-xii

b. Each individual PL# with it’s respective value for i-xii

c. Sum of Equal. Time in buckets for all data

3) Output graphs to a new sheet:

a. All dates (y) and * % State of Charge (x) 2D line graph, y axis 0-100, with

a constant green line at 100 and a constant red line at 20

b. All dates and temps 2D line graph with a constant red line at 138

I am working on (1). This is how I will scan and collect each chunk...

Sub GetData()

Dim ArrPK() As String, SearchString As String
Dim SerialNo As Range, aCell As Range
Dim ws As Worksheet
Dim PkCounter As Long
Dim LstBox As msforms.ListBox

Set ws = ThisWorkbook.Sheets("Sheet1")
SearchString = "Serial#"
Set LstBox = UserForm1.ListBox1

PkCounter = 1

With ws
Set SerialNo = .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)

For Each aCell In SerialNo
If aCell.Value2 = SearchString Then
ReDim Preserve ArrPK(1 To 5, 1 To PkCounter)
ArrPK(1, PkCounter) = aCell.Offset(0, 1) 'Serial#
ArrPK(2, PkCounter) = aCell.Offset(1, 1) 'Firmware#
ArrPK(3, PkCounter) = aCell.Offset(3, 1) 'Capacity
ArrPK(4, PkCounter) = aCell.Offset(3, 3) 'Technology
ArrPK(5, PkCounter) = aCell.Offset(3, 11) 'Battery#
'Collected information labels, now run calculations...
PkCounter = PkCounter + 1
End If
Next
End With


WHAT I WANT TO DO:. I'd like to output a table with the collected labels and corresponding calculations. The loop I have so far gets the labels.

Example file:

https://drive.google.com/open?id=1vDqnt2aHL06xB2Fg9k5MZ2WeCefqQZ1n1

1 Answer
1

this requires more coding, you can parametrize it a lot more, but also keeping it simple has benefits if you export excel file format will not change. I calculated the average temperature and inserted it in your array. Once you collected all of your data you need to transpose your array and paste it in a sheet:

Sub GetData()

Dim ArrPK() As String, SearchString As String
Dim SerialNo As Range, aCell As Range
Dim ws As Worksheet
Dim PkCounter As Long
'Dim LstBox As msforms.ListBox
Dim rng As Range

Set ws = ThisWorkbook.Sheets("Sheet1")
SearchString = "Serial#"
'Set LstBox = UserForm1.ListBox1

PkCounter = 1

With ws
Set SerialNo = .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)

For Each aCell In SerialNo
If aCell.Value2 = SearchString Then
ReDim Preserve ArrPK(1 To 6, 1 To PkCounter)
ArrPK(1, PkCounter) = aCell.Offset(0, 1) 'Serial#
ArrPK(2, PkCounter) = aCell.Offset(1, 1) 'Firmware#
ArrPK(3, PkCounter) = aCell.Offset(3, 1) 'Capacity
ArrPK(4, PkCounter) = aCell.Offset(3, 3) 'Technology
ArrPK(5, PkCounter) = aCell.Offset(3, 11) 'Battery#


'define the data block for the battery
Set rng = aCell.CurrentRegion 'data block for one battery
Set rng = rng.Offset(6, 0)
Set rng = rng.Resize(rng.Rows.Count - 6, rng.Columns.Count)

'now range is defined, run the calculations using the worksheet functions, or use a loop over the range columns
'### calculate avg, min and max temperature (8th column in block)
ArrPK(6, PkCounter) = Application.WorksheetFunction.Average(rng.Columns(8)) 'average temperature



PkCounter = PkCounter + 1
End If
Next
End With
End Sub


Thanks for contributing an answer to Stack Overflow!

But avoid …

To learn more, see our tips on writing great answers.

Required, but never shown

Required, but never shown

By clicking "Post Your Answer", you acknowledge that you have read our updated terms of service, privacy policy and cookie policy, and that your continued use of the website is subject to these policies.