Custom Range and Listbox Rowsource

alshanky

New Member
Joined
Dec 13, 2022
Messages
2
Office Version
  1. 2019
Platform
  1. Windows
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.

VBA Code:
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
 
Last edited by a moderator:

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
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.

VBA Code:
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
 
Upvote 0
Solution
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?

VBA Code:
 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")
 
Upvote 0
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.
VBA Code:
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:
VBA Code:
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
 
Upvote 0

Forum statistics

Threads
1,223,227
Messages
6,170,848
Members
452,361
Latest member
d3ad3y3

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top