mattreingold
05-24-2018, 05:44 AM
Hello, I have a task that I feel should be easy, however I cannot understand why I cannot get it to work. I had imported a column in the form of a column array from another spreadsheet, and set the beginning and end 10% of data points to 0. What I would like - if possible - would be to resize the array by totally removing these elements whose values are now set to zero (depending on the array usually the first and last 30-40 elements).
Below is my code, and attached is a picture of an example of the kind of column I get as a reset (with the zeros I wish to delete).
Thanks!
'//
Sub RunReport()
Set WBT = Workbooks("PeelTestReport.xlsm")
Set WPN = WBT.Worksheets("Sheet2")
Dim xlFile As Variant
Dim numberOfFiles As Integer
numberOfFiles = InputBox("Enter Number of Spreadsheets to Open")
Dim fileNames(100) As String
Dim TotalRows As Integer
Dim Counter As Integer
Dim loadArr()
Dim loadArrUsable As Variant
Counter = 0
ChDir "C:\Users\mreingold\Documents\Peel Testing"
For i = 1 To numberOfFiles
' Showing Excel Dialog
xlFile = Application.GetOpenFilename("All Excel Files (*.csv*)," & _
"*.xls*", 1, "Select Excel File", "Open", False)
' Open selected file
Workbooks.Open xlFile
xlFileName = Right(xlFile, 34)
' Establish important values from sheet
TotalRows = Rows(Rows.Count).End(xlUp).Row
loadArr = Range("B2:B" & TotalRows).Value
' Capture data points from -0.15N to 0.15N (Removes extraneous data points)
idx = 0
For t = 1 To UBound(loadArr)
If Abs(loadArr(t, 1)) >= 0.5 Then
idx = idx + 1
loadArr(idx, 1) = Abs(loadArr(t, 1))
End If
Next t
' Create variables to handle ends of data set
endIdx = Round((idx / 10), 0) ' Represents 10% of the data set
UsideIdx = idx - endIdx ' Represents the last 10% of the data set
ultimateIdx = UsideIdx - endIdx
' Loops to remove begining and end 10% of data points
For g = 1 To endIdx
loadArr(g, 1) = 0
Next g
For n = UsideIdx To idx
loadArr(n, 1) = 0
Next n
If Counter = 0 Then
WPN.Range("A1:A" & idx) = loadArr
ElseIf Counter = 1 Then
WPN.Range("B1:B" & idx) = loadArr
ElseIf Counter = 2 Then
...
'//
2231322314
Below is my code, and attached is a picture of an example of the kind of column I get as a reset (with the zeros I wish to delete).
Thanks!
'//
Sub RunReport()
Set WBT = Workbooks("PeelTestReport.xlsm")
Set WPN = WBT.Worksheets("Sheet2")
Dim xlFile As Variant
Dim numberOfFiles As Integer
numberOfFiles = InputBox("Enter Number of Spreadsheets to Open")
Dim fileNames(100) As String
Dim TotalRows As Integer
Dim Counter As Integer
Dim loadArr()
Dim loadArrUsable As Variant
Counter = 0
ChDir "C:\Users\mreingold\Documents\Peel Testing"
For i = 1 To numberOfFiles
' Showing Excel Dialog
xlFile = Application.GetOpenFilename("All Excel Files (*.csv*)," & _
"*.xls*", 1, "Select Excel File", "Open", False)
' Open selected file
Workbooks.Open xlFile
xlFileName = Right(xlFile, 34)
' Establish important values from sheet
TotalRows = Rows(Rows.Count).End(xlUp).Row
loadArr = Range("B2:B" & TotalRows).Value
' Capture data points from -0.15N to 0.15N (Removes extraneous data points)
idx = 0
For t = 1 To UBound(loadArr)
If Abs(loadArr(t, 1)) >= 0.5 Then
idx = idx + 1
loadArr(idx, 1) = Abs(loadArr(t, 1))
End If
Next t
' Create variables to handle ends of data set
endIdx = Round((idx / 10), 0) ' Represents 10% of the data set
UsideIdx = idx - endIdx ' Represents the last 10% of the data set
ultimateIdx = UsideIdx - endIdx
' Loops to remove begining and end 10% of data points
For g = 1 To endIdx
loadArr(g, 1) = 0
Next g
For n = UsideIdx To idx
loadArr(n, 1) = 0
Next n
If Counter = 0 Then
WPN.Range("A1:A" & idx) = loadArr
ElseIf Counter = 1 Then
WPN.Range("B1:B" & idx) = loadArr
ElseIf Counter = 2 Then
...
'//
2231322314