Option Explicit Global _ DataWB As Workbook, DataWS As Worksheet, _ rngC1 As Range, rngC2 As Range, rngC3 As Range, _ startDepth As Double, EndDepth As Double, _ i As Integer, _ dLBd As Double, dUBd As Double '<------------------Set mininum limit for TGas to be processed-------> Const TGasLmt As Double = 25 '<------------------interval for data loop-------------> 'its derived from how much footage within a 2.5min cycle gets same chromat values Const WVI As Double = 10.2 Sub Call_me() readRangetoArray (8615.5) End Sub Function readRangetoArray(ByVal userInput As Double) Call Config_Functions.declarePublicVars Dim strIn As String strIn = "XXXXXX" 'path to csv file of data to be processed then written back to Workbooks.OpenText Filename:=strIn, DataType:=xlDelimited, comma:=True Set DataWB = Workbooks(strIn): Set DataWS = DataWB.Sheets(1): DataWB.Save Dim lROPCol As Long: lROPCol = 2 Dim lTGasCol As Long: lTGasCol = 3 Dim lC1Col As Long: lC1Col = lTGasCol + 1 Dim lC2Col As Long: lC2Col = lTGasCol + 2 Dim lC3Col As Long: lC3Col = lTGasCol + 3 Dim lStartRow As Long With DataWS Dim lROPCol As Long: lROPCol = 2 Dim lTGasCol As Long: lTGasCol = 3 Dim lC1Col As Long: lC1Col = lTGasCol + 1 Dim lC2Col As Long: lC2Col = lTGasCol + 2 Dim lC3Col As Long: lC3Col = lTGasCol + 3 Dim lStartRow As Long With DataWS lStartRow = .Columns("A").Find(userInput, _ LookIn:=xlValues, _ LookAt:=xlPart, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=True, _ SearchFormat:=False).Row startDepth = userInput: LastUsedRow = .cells(.Rows.Count, lTGasCol).End(xlUp).Row: EndDepth = .cells(LastUsedRow, 1) Set rngC1 = .Range(.cells(lStartRow, lC1Col), .cells(LastUsedRow, lC1Col)) 'identify range to write generated c1 Set rngC2 = .Range(.cells(lStartRow, lC2Col), .cells(LastUsedRow, lC2Col)) 'identify range to write generated c2 Set rngC3 = .Range(.cells(lStartRow, lC3Col), .cells(LastUsedRow, lC3Col)) 'identify range to write generated c3 Dim rngROP As Range: Set rngROP = .Range(.cells(lStartRow, lROPCol), .cells(LastUsedRow, lROPCol)) 'Set ROP Range to read from Dim rngTGas As Range: Set rngTGas = .Range(.cells(lStartRow, lTGasCol), .cells(LastUsedRow, lTGasCol)) 'Set Total Gas Range to read from End With Dim arrROP() As Double, arrTGas() As Double arrROP = rngtoArrD(rngROP) ' pass to function that loops range into array arrTGas = rngtoArrD(rngTGas) ' pass to function that loops range into array arrROP = arrROPmin(arrROP) ' pass to function that loops range into array processGasCalc arrROPmin:=arrROP, arrTGas:=arrTGas End Function Function rngtoArrD(rng As Range) As Double() Dim rCells As Range Dim tempArr() As Double: ReDim tempArr(rng.cells.Count) i = 0 For Each rCells In rng tempArr(i) = CDbl(rCells.Value) i = i + 1 Next rngtoArrD = tempArr() End Function Function arrROPmin(arr() As Double) As Double() Dim k As Double, lResult As Double Dim tempArr() As Double 'dLBd assigned to Low Bounds / dUBd assinged to Upper Bounds of arr dLBd = LBound(arr): dUBd = UBound(arr) ReDim tempArr(dLBd To dUBd): For i = dLBd To dUBd: k = i '-----------------------Areas of concern - better way?---------------------- Select Case True Case arr(i) > 0: lResult = (60 / arr(i)) Case arr(i) = 0 If k > dUBd Then GoTo exitf If arr(k) = 0 And k >= dLBd And k < dUBd Then Do Until arr(k) >= 0 k = k + 1 lResult = (60 / arr(k)) Loop ElseIf arr(k) = 0 And k < dUBd And k >= dLBd Then Do Until arr(k) > 0 k = k - 1 If arr(k) > 0 Then lResult = (60 / arr(k)) End If Loop End If End Select '-----------------------end Areas of concern - better way?---------------------- tempArr(i) = lResult Next i exitf: ReDim arrROPmin(LBound(tempArr) To UBound(tempArr)): arrROPmin = tempArr() End Function Function calcChromatD(TGas As Double, C1F As Double, C2F As Double, C3F As Double) Dim intC1LmT As Integer, intC2LmT As Integer, intC3LmT As Integer 'Declare limits to assign values of 0 if below intC1LmT = 25: intC2LmT = 10: intC3LmT = 5 C1F = 0.677737226: C2F = 0.115255474: C3F = 0.077170418 C1F = C1F * TGas: C2F = C2F * TGas: C3F = C3F * TGas Select Case C1F Case Is <= intC1LmT: C1F = 0: C2F = 0: C3F = 0: GoTo endfunc End Select Select Case C2F Case Is <= intC2LmT: C2F = 0: C3F = 0: GoTo endfunc End Select Select Case C3F Case Is <= intC3LmT: C3F = 0 End Select endfunc: End Function Function processGasCalc(arrROPmin() As Double, arrTGas() As Double) Call arrLoadScaleFactors Dim x As Long, o As Long, gGas As Long x = 0: gGas = 0: o = 0: '<------------Set arrC1-C3 to length needed------------> Dim arrC1() As Double: ReDim arrC1(dLBd To dUBd) Dim arrC2() As Double: ReDim arrC2(dLBd To dUBd) Dim arrC3() As Double: ReDim arrC3(dLBd To dUBd) Dim tempC1 As Double, tempC2 As Double, tempC3 As Double 'for each of the items in arrROPmin values loop Dim firstPASSbool As Boolean, kROP As Double, lAccum As Double '-----------------------Areas of concern - better way?---------------------- For x = dLBd To dUBd 'when it loops back around lAcuum updates it self to static lAccum = lAccum + arrROPmin(x) If lAccum >= WVI And arrTGas(x) > TGasLmt Or firstPASSbool = False Then 'if the totalgas Value at Rop index position is greater than 35 o = x calcChromatD TGas:=arrTGas(x), C1F:=tempC1, C2F:=tempC2, C3F:=tempC3 kROP = lAccum + WVI 'inner loop 'lAccum adds ROPmin till get to limit of 11.5 Do Until lAccum >= kROP 'arrC1,C2,C3 are assigned values from 1st Do until Loop arrC1(o) = tempC1: arrC2(o) = tempC2: arrC3(o) = tempC3: Sleep 15 'Close inner Do until loop when ROPmin has reached 11.5 from previous value lAccum = lAccum + arrROPmin(o) o = o + 1 If o >= dUBd Then GoTo exitf Loop firstPASSbool = 0 'loops 1st Do While lAccum = 0 x = o - 1 End If Next x '-----------------------end Areas of concern - better way?---------------------- exitf: writeChromatToRange arrC1:=arrC1, arrC2:=arrC2, arrC3:=arrC3 End Function Function writeChromatToRange(arrC1 As Variant, arrC2 As Variant, arrC3 As Variant) rngC1 = Application.WorksheetFunction.Transpose(arrC1) rngC2 = Application.WorksheetFunction.Transpose(arrC2) rngC3 = Application.WorksheetFunction.Transpose(arrC3) Sleep 250 MsgBox "Done" End Function
The data below is stored in a csv file The column of data to the right of the total gas column is what the output of this entire module would be The ROP defines that rate in which how many times the values will be written within a variable time of ROP. Depth ROP Total Gas 8615.5 124.5 30.1 30 28 0 0 0 8616 121.7 29.45 30 28 0 0 0 0 8616.5 120.6 30.1 30 29 0 0 0 0 8617 121.6 30.38 30 29 0 0 0 0 8617.5 116.8 29.66 30 29 0 0 0 0 8618 113.8 29.7 30 30 0 0 0 0 8618.5 115.5 29.7 30 30 0 0 0 0 8619 112.4 29.62 30 31 0 0 0 0 8619.5 106.8 30.05 30 32 0 0 0 0 8620 100.5 29.3 30 36 0 0 0 0 8620.5 101.7 29.28 30 36 0 0 0 0 8621 117.5 30.51 30 36 0 0 0 0 8621.5 135.5 32.29 30 43 0 0 0 0 8622 132.5 32.84 30 43 0 0 0 0 8622.5 109.5 32.49 30 43 0 0 0 0 8623 95.8 32.51 30 43 0 0 0 0 8623.5 67.8 29.94 30 47 0 0 0 0 8624 56.3 32.82 30 47 0 0 0 0 8624.5 56.2 31.82 30 47 0 0 0 0 8625 52 32.21 30 47 0 0 0 0 8625.5 54.1 30.69 30 47 0 0 0 0 8626 64 27.38 30 41 0 0 0 0 8626.5 95.5 31.91 30 41 0 0 0 0 8627 115.8 31.98 30 41 0 0 0 0 8627.5 93.7 32.58 30 41 0 0 0 0 8628 91.7 31.87 30 41 0 0 0 0 8628.5 93.7 32.57 30 41 0 0 0 0 8629 97.7 31.51 30 41 0 0 0 0 8629.5 104.3 32.33 30 35 0 0 0 0 8630 101.4 31.92 30 35 0 0 0 0 8630.5 94.8 32.98 30 34 0 0 0 0 8631 95 31.6 30 34 0 0 0 0 8631.5 100 32.7 30 30 0 0 0 0 8632 101.2 32.45 30 30 0 0 0 0 8632.5 97.3 32.54 30 30 0 0 0 0 8633 98.5 32.66 30 28 0 0 0 0 8633.5 103 31.85 30 28 0 0 0 0 8634 106.6 32.56 30 28 0 0 0 0 8634.5 106.4 31.79 30 28 0 0 0 0 8635 108.2 32.47 30 26 0 0 0 0 8635.5 109.3 32.27 30 26 0 0 0 0 8636 114.4 32.4 30 26 0 0 0 0 8636.5 119.8 31.93 30 26 0 0 0 0 8637 119.4 32.12 30 26 0 0 0 0 8637.5 127 32.81 30 26 0 0 0 0 8638 134.9 31.9 30 26 0 0 0 0 8638.5 141 32.08 30 26 0 0 0 0 8639 142.9 32.6 30 26 0 0 0 0 8639.5 140.5 32.45 30 26 0 0 0 0 8640 140.7 32.58 30 26 0 0 0 0 8640.5 140.6 32.44 30 28 0 0 0 0 8641 143.9 32 30 28 0 0 0 0 8641.5 145.7 32.26 30 28 0 0 0 0 8642 141.6 32.86 30 29 0 0 0 0 8642.5 141.4 32.41 30 29 0 0 0 0 8643 140.8 32.06 30 29 0 0 0 0 8643.5 143.7 32.32 30 30 0 0 0 0 8644 148.3 32.45 30 30 0 0 0 0 8644.5 154.9 34.22 30 33 0 0 0 0 8645 166.3 34.03 30 33 0 0 0 0 8645.5 163 35.72 30 34 0 0 0 0 8646 153.5 35.74 30 34 0 0 0 0 8646.5 140.6 35 30 71 0 0 0 0 8647 133.5 35.27 30 71 0 0 0 0 8647.5 0 18.56 0 22 0 0 0 0 8648 119.7 20.5 0 22 0 0 0 0 8648.5 82.6 30.96 0 22 0 0 0 0 8649 44.3 33.15 0 20 0 0 0 0 8649.5 31 33.9 0 20 0 0 0 0 8650 0 29.5 7 18 0 0 0 0 8650.5 38 30.5 18 18 0 0 0 0 8651 33.5 32.64 15 19 0 0 0 0 8651.5 25.8 30.84 8 19 0 0 0 0 8652 15.9 28.12 18 20 0 0 0 0 8652.5 13 28.83 10 18 0 0 0 0 8653 17.1 29.9 7 17 0 0 0 0 8653.5 26.4 31.37 18 17 0 0 0 0 8654 0 24.39 19 19 0 0 0 0 8654.5 23.8 27.99 13 19 0 0 0 0 8655 25.7 33.24 9 19 0 0 0 0 8655.5 36.3 39.42 16 18 0 0 0 0 8656 38.5 41.83 18 18 0 0 0 0 8656.5 40.4 44.52 9 18 0 0 0 0 8657 43.2 44.74 7 19 0 0 0 0 8657.5 43.7 44.94 7 19 0 0 0 0 8658 41.4 39.34 12 20 0 0 0 0 8658.5 40.9 38.58 10 23 0 0 0 0 8659 41.9 38.36 9 24 0 0 0 0 8659.5 42.6 38.46 11 25 0 0 0 0 8660 42.2 36.95 11 27 0 0 0 0 8660.5 43.4 38.25 10 28 0 0 0 0 8661 48.9 38.91 16 28 0 0 0 0 8661.5 50 39.24 10 29 0 0 0 0
Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.
”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.
Our community of experts have been thoroughly vetted for their expertise and industry experience.