Custom Range and Listbox Rowsource

[alshanky]

I have written a GetRange function that populates a range based on a certain criteria as below. Now when I try to use the range created to display on to a listbox on a form, nothing gets displayed even though printing the GetRange below to a sheet works perfectly fine.

Public Function GetRange() As Range

Dim i As Long
Dim lastRowMvmtConsol As Long
Dim mvmtConsolSheet As String

mvmtConsolSheet = "Cash_Stock_Mvmt_Consol"
lastRowMvmtConsol = ActiveWorkbook.Sheets(mvmtConsolSheet).Range("A1").End(xlDown).Row

Set GetRange = ActiveWorkbook.Sheets(mvmtConsolSheet).Range("A1:R1")
'Set GetRange = ActiveWorkbook.Sheets(mvmtConsolSheet).Range("A1:R1")

For i = 2 To lastRowMvmtConsol
If ActiveWorkbook.Sheets(mvmtConsolSheet).Cells(i, 12).Value = "Transfers-In" Then
Set GetRange = Application.Union(GetRange, ActiveWorkbook.Sheets(mvmtConsolSheet).Range("A" & i & ":R" & i))
End If
Next i
'GetRange.Copy ActiveWorkbook.Sheets("Sheet1").Range("A1")

End Function

Private Sub Addtolistbox()
Dim rg As Range
Dim mvmtConsolSheet As String
mvmtConsolSheet = "Cash_Stock_Mvmt_Consol"

Set rg = GetRange()
'Set rg = ActiveWorkbook.Sheets(mvmtConsolSheet).Range(rg)


With lstDatabase

.RowSource = rg.Address '(external:=True)
.ColumnCount = rg.Columns.Count
.ColumnWidths = "50,50,60,60,60,60,70,80,90,90,90,90,90,90,90,90,90,90"
.ColumnHeads = True
'.ListIndex = 0

End With

End Sub

 

[John_w]

Welcome to MrExcel forums (please use the VBA icon in the message editor when posting VBA code).

Now when I try to use the range created to display on to a listbox on a form, nothing gets displayed even though printing the GetRange below to a sheet works perfectly fine.

The trouble is, .RowSource = rg.Address displays the values in rg only if rg is a contiguous range.

The solution is to copy rg to some spare cells on the sheet (or another sheet) to create a contiguous range and use that as the RowSource - I chose cells starting at AA1.

Private Sub Addtolistbox()

    Dim rg As Range
    Dim mvmtConsolSheet As String
    
    mvmtConsolSheet = "Cash_Stock_Mvmt_Consol"
    
    Set rg = GetRange()
    
    With Worksheets("Cash_Stock_Mvmt_Consol")
        .Range("AA1").CurrentRegion.Clear
        rg.Copy .Range("AA1")
    End With
    
    With lstDatabase
        .RowSource = Worksheets("Cash_Stock_Mvmt_Consol").Range("AA1").CurrentRegion.Offset(1).Address
        .ColumnCount = rg.Columns.Count
        .ColumnWidths = "50,50,60,60,60,60,70,80,90,90,90,90,90,90,90,90,90,90"
        .ColumnHeads = True
    End With

End Sub

 

[alshanky]

Thanks John, I assumed that because it isn't contiguous range, it isn't working as well too. So have copied on to a different sheet, see below and it works fine.

I also want to add the row number for "Transfers-In" record i.e. i to the Range, may be insert as first column. This is so that the other details I gather for the row can be pasted to the right record on the [mvmtConsolSheet] sheet. How do I accomplish that?

 Set rng = ActiveWorkbook.Sheets(mvmtConsolSheet).Range("A1:R1")
    
    For i = 2 To lastRowMvmtConsol
        If ActiveWorkbook.Sheets(mvmtConsolSheet).Cells(i, 12).Value = "Transfers-In" Then
            Set rng = Application.Union(rng, ActiveWorkbook.Sheets(mvmtConsolSheet).Range("A" & i & ":R" & i))
        End If
    Next i

    rng.Copy ActiveWorkbook.Sheets(tfrSheet).Range("A1")

 

[John_w]

I also want to add the row number for "Transfers-In" record i.e. i to the Range, may be insert as first column.

Is this what you mean?

This Create_TransfersIn_Range function replaces your GetRange function. It copies the "Transfers-In" rows from the "Cash_Stock_Mvmt_Consol" sheet to a sheet named "Transfers-In", with the row number put in column A.

Public Function Create_TransfersIn_Range() As Range

    Dim i As Long, r As Long
    Dim TransfersInSheet As Worksheet
    
    Set TransfersInSheet = ActiveWorkbook.Worksheets("Transfers-In")
    TransfersInSheet.Cells.Clear
    
    With ActiveWorkbook.Worksheets("Cash_Stock_Mvmt_Consol")
        r = 1
        TransfersInSheet.Cells(r, 1).Value = "Row"
        .Range("A1:R1").Copy TransfersInSheet.Cells(r, 2)
        For i = 2 To .Range("A1").End(xlDown).Row
            If .Cells(i, 12).Value = "Transfers-In" Then
                r = r + 1
                TransfersInSheet.Cells(r, 1).Value = i
                .Range("A" & i & ":R" & i).Copy TransfersInSheet.Cells(r, 2)
            End If
        Next
    End With
    
    Set Create_TransfersIn_Range = TransfersInSheet.UsedRange
    
End Function

Change your AddToListbox subroutine to:

Private Sub AddToListbox()

    Dim TransfersInRange As Range
    
    Set TransfersInRange = Create_TransfersIn_Range()
    
    With lstDatabase
        .RowSource = "'" & TransfersInRange.Worksheet.Name & "'!" & TransfersInRange.Offset(1).Address
        .ColumnCount = TransfersInRange.Columns.Count
        .ColumnWidths = "30,50,50,60,60,60,60,70,80,90,90,90,90,90,90,90,90,90,90"
        .ColumnHeads = True
    End With

End Sub