Looping to Collect Labels and Calculations

Question

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

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