VBA Array Function - Return Array from Range without Blanks

Question

I am struggling with a basic problem in VBA and would appreciate some help. I want to define a function which returns an array from a range without blanks, as shown below:

So when I call the function in the European Option cell, the function should return an array without any blanks, like on the right hand side.

This is the code I have so far:

   Function portfolioX(N)
   Dim MyArray(3)
   Dim i As Integer
   counter = 1
    For i = 1 To N
        If IsEmpty(i) Then
            Next i
        Else
            portfolio = MyArray
            MyArray (counter)
            counter = counter + 1
            Next i
        End If
End Function

I am a newbie to VBA, so this could be completely wrong. Thanks!

Answer 1

If statement and loop are blocks of code. You can not interlace blocks of code.

Function portfolioX(N)

    For i = 1 To N ' Block 1 starts
        If IsEmpty(i) Then ' Block 2 starts
        Next i 'Block 1 can't loop back because Block 2 has't closed
    Else
        portfolio = MyArray
        MyArray (counter)
        counter = counter + 1
    Next i 'Block 1 can't loop back because Block 2 has't closed
    End If ' Block 2

End Function

When coding it is code practice to write the complete loop structure then fill in the inner code. I would write the For loop first

For i = 1 to N

next i

Next comes the If block

For i = 1 To N
    If IsEmpty(i) Then

    End If
Next i

And finally

Function portfolioX(N)
    Dim MyArray(3)
    Dim i As Integer
    counter = 1
    For i = 1 To N ' Block 1 Starts
        If IsEmpty(i) Then Block 2 Starts
            portfolio = MyArray
            MyArray (counter)
            counter = counter + 1
        End If ' Block 2 Closes
    Next i 'If the Loop Condition is meet, Block 1 Closes, else i is incremented and the loop starts over
End Function

Answer 2

Given what you are asking for, I've written a quick sub that will take whatever range you have highlighted and paste the values with the blank cells removed at the end of the row. Hopefully this can give you a start towards what you are hoping to accomplish.

Sub RemoveBlanks()

Dim OriginalRange As Range, WorkCell As Range, PasteCol As Integer
Set OriginalRange = Selection.Rows(1) 'Ensures only one row of data is selected
PasteCol = Range(Cells(OriginalRange.Row, ActiveSheet.UsedRange.Columns.Count + 2).Address).End(xlToLeft)
For Each WorkCell In OriginalRange
    If Not IsEmpty(WorkCell) Then
        Cells(OriginalRange.Row, PasteCol).Value = WorkCell.Value
        PasteCol = PasteCol + 1
Next WorkCell

End Sub

Answer 3

Based on your question and comments in that thread, I understand that you wish to take a given range (supplied to the procedure) and print all non-empty values to some range starting on the same row in column R (the 18th column).

In a comment, you supply the ranges A1:A13 and A18:A21 , but those do not match with your screenshot. I assume you meant row 1 (or some arbitrary row), columns 1 to 13 and columns 18 to 21.

Here is a solution to that problem:

Sub arrayPaster(rng As Range)
    Dim s() As Variant, r() As Variant, j As Integer

    ReDim r(1 To 1, 1 To 1)
    s = rng.Value
    j = 1

    For i = 1 To UBound(s, 2)
        If s(1, i) <> "" Then
            ReDim Preserve r(1 To 1, 1 To j)
            r(1, j) = s(1, i)
            j = j + 1
        End If
    Next i

    Range("R" & rng.Row).Resize(1, UBound(r, 2)).Value = r
End Sub