Excel vba select non blank cells in column A and create array offset from B

Question

I have a list of values in column A2:A10 some are empty What I would like to do is create a comma separated array of the adjacent values in column B.

Therefore if A3 = X and A6 = X and A9 = X
The result should be what is in Column B i.e. B3 = Y and B6 = Y and B9 = Y
These need to be presented in a comma separated array i.e. y,y,y

Note: the x and y values are different numbers, not actual X or Y

I can create the array offset, using the following but it selects all the values in column B, whereas I only want the adjacent ones from column A

Dim arr
Dim LR As Long

    LR = Range("A" & Rows.Count).End(xlUp).Row
    On Error Resume Next    'if only 1 row
    arr = Join(Application.Transpose(ThisWorkbook.Sheets("ID").Range("A2:A" & LR).Offset(0, 1).Value), ",")

MsgBox arr

Answer 1

There is no (probably) a simple method to create an array from discontinuous data range Solutions can be many. Here's the next one.

Sub Makro1()
    Dim rngScope    As Range
    Dim varArr      As Variant

    With Range("A1")
        .Value = "X"
        .CurrentRegion.AutoFilter Field:=1, Criteria1:="<>"
        Set rngScope = .CurrentRegion.Columns(2)
    End With

    With rngScope
        Set rngScope = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
    End With

    rngScope.Copy Range("E1")

    With Range("E1").CurrentRegion
        varArr = .Value
        ActiveSheet.ShowAllData
        .Clear
    End With

    With Range("A1")
        .ClearContents
        .AutoFilter
    End With

    varArr = Join(Application.Transpose(varArr), ",")

    MsgBox varArr

End Sub

Artik

Answer 2

So you don't need to use an Application function for this function. You just need to build up the list of values, based on the state of the cell beside it. Here is some example code you can use:

Option Explicit

Sub test()
    Debug.Print SelectedList(ThisWorkbook.Sheets("ID").Range("A1:B10"))
End Sub

Public Function SelectedList(ByRef inputArea As Range) As String
    '--- the inputArea is a two-column range in which the left-hand column
    '    "selects" the value in the right-hand column by being non-blank
    '    the function returns a comma-separated string of values
    Dim listResult As String
    Dim dataPair As Range
    For Each dataPair In inputArea.Rows
        If Not IsEmpty(dataPair.Cells(, 1)) Then
            listResult = listResult & dataPair.Cells(, 2).Value & ","
        End If
    Next dataPair
    '--- return the list (and strip off the trailing comma)
    SelectedList = Left$(listResult, Len(listResult) - 1)
End Function

And, as an added bonus, you can "call" this function directly from your worksheet. Just put this formula into a cell =SelectedList(A1:B10) and the resulting list will appear in the cell.