Removing end elements of an array (they are all 0)

[mattreingold]

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
...
'//


LowerArray.jpgUpperArray.jpg

[mattreingold]

Below is what I tried.

For r = 1 To ultimateIdx
For w = endIdx To UsideIdx
loadArrUsable(r, 1) = loadArr(w, 1)
Next w
Next r

[Paul_Hossler]

Simple brute force way

Option Explicit

Sub MoveArray()
    Dim ultimateIdx As Long, N As Long, r As Long
    Dim loadArr As Variant, loadArrUsable() As Double

    'testing setup
    ultimateIdx = 30
    loadArr = ActiveSheet.Cells(1, 1).CurrentRegion.Value

    'try this
    
    'counts <> 0 to see new array UB
    N = 0
    For r = LBound(loadArr, 1) To UBound(loadArr, 1)
        If loadArr(r, 1) > 0# Then N = N + 1
    Next r
    'size the new array
    ReDim loadArrUsable(1 To N)
    
    N = 0
    
    'move <> 0 values
    For r = LBound(loadArr, 1) To UBound(loadArr, 1)
        If loadArr(r, 1) > 0# Then
            N = N + 1
            loadArrUsable(N) = loadArr(r, 1)
        End If
    Next r
    
    ActiveSheet.Cells(1, 3).Resize(N, 1).Value = Application.WorksheetFunction.Transpose(loadArrUsable)
End Sub

[mattreingold]

I wasn't super explicit with what I needed so I had to tweak it a little bit, but thanks to your guidance and excellent solution I was able to fix my mistakes! Thank you very very much!

[jolivanes]

This might work also.

Sub No_Zeros()
Dim a, b, i As Long, j As Long
a = ActiveSheet.Cells(1, 1).CurrentRegion.Value
ReDim b(UBound(a, 1))
j = 0
    For i = LBound(a, 1) To UBound(a, 1)
        If a(i, 1) > 0 Then b(j) = a(i, 1): j = j + 1
    Next i
ReDim Preserve b(WorksheetFunction.Count(b))
Cells(1, 3).Resize(UBound(b)) = Application.Transpose(b)
End Sub

[snb]

Did you consider 'soft force' ?

Sub M_snb()
  columns(1).replace 0,"",1
  columns(1).specialcells(2).cut cells(1)
End SUb

[mattreingold]

snb, this is something I also realized after the fact. That is a common approach I use in other languages, and through research found someone suggesting setting the contents to "N/A". I figured that was the VBA version of "" (empty contents - auto resizing) however it just set the contents to a string of N/A, should have figured. Thanks all for the help though!

[snb]

Did yo test my suggestion, because

I figured that was the VBA version of "" (empty contents - auto resizing) however it just set the contents to a string of N/A,

isn't correct.

[mattreingold]

I actually got my issue to work with Paul_Hossler's solution, but I definitely think yours would work (every programmers famous last words) it seems super straight forward and logical. I appreciate all of the hasty feedback!