Search code examples
excelvbalistboxuserform

Populate last rows of Excel sheet to VBA UserForm List


I want to populate lets say 5 last row to user Form List, but not like from A B C D columns like now but choose specific ones like A B D G can someone help with that?

My code:

With wbMaster
    
     lr2 = .Cells(.Rows.count, 1).End(xlUp).Row
     lr3 = .Cells(.Rows.count, 1).End(xlUp).Offset(-1).Row
     lr4 = .Cells(.Rows.count, 1).End(xlUp).Offset(-2).Row
     lr5 = .Cells(.Rows.count, 1).End(xlUp).Offset(-3).Row
     lr6 = .Cells(.Rows.count, 1).End(xlUp).Offset(-4).Row
     lr7 = .Cells(.Rows.count, 1).End(xlUp).Offset(-5).Row
     lr8 = .Cells(.Rows.count, 1).End(xlUp).Offset(-6).Row
     lr9 = .Cells(.Rows.count, 1).End(xlUp).Offset(-7).Row
   
    TestSheet.lstLast.ColumnCount = 3
    For Y = 1 To 3
      
        X(1, Y) = .Cells(lr2, Y)
        X(2, Y) = .Cells(lr3, Y)
        X(3, Y) = .Cells(lr4, Y)
        X(4, Y) = .Cells(lr5, Y)
        X(5, Y) = .Cells(lr6, Y)
        X(6, Y) = .Cells(lr7, Y)
        X(7, Y) = .Cells(lr8, Y)
        X(8, Y) = .Cells(lr9, Y)
       
    Next Y
            TestSheet.lstLast.List = X
End With

I tried for but with loops did not help me


Solution

  • Populate a List Box With n Last Rows of Specified Columns of a Range

    The Main Function

    • This will return the array with the results. It calls both helper functions.
    • Adjust the values in the constants section.
    Function GetLastRowColumns() As Variant
        
        ' Define constants.
        Const SRC_NAME As String = "Sheet1"
        Const LAST_ROWS_COUNT As Long = 5
        Dim SRC_COLS(): SRC_COLS = Array("A", "B", "D", "G")
        
        ' Reference the Source worksheet ('sws').
        Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
        Dim sws As Worksheet: Set sws = wb.Sheets(SRC_NAME)
        
        ' Reference the Source Data range ('srg').
        Dim srg As Range
        With sws.Range("A1").CurrentRegion ' Source Table Range (has headers)
            Set srg = .Resize(.Rows.Count - 1).Offset(1) ' no headers
        End With
        
        ' Using the 'RefLastRows' function, reference the last rows ('slrg').
        Dim slrg As Range: Set slrg = RefLastRows(srg, LAST_ROWS_COUNT)
        If slrg Is Nothing Then Exit Function ' not enough rows
        Debug.Print slrg.Address
        
        ' Using the 'GetRangeColumns' function, return the values from the last rows
        ' in a 2D array ('Data').
        Dim Data(): Data = GetRangeColumns(slrg, SRC_COLS)
    
        GetLastRowColumns = Data
    
    End Function
    

    The Helper Functions

    Function RefLastRows( _
        ByVal SourceRange As Range, _
        ByVal LastRowsCount As Long) _
    As Range
        With SourceRange.Areas(1)
            Dim rCount As Long: rCount = .Rows.Count
            If rCount < LastRowsCount Then Exit Function
            Set RefLastRows = .Resize(LastRowsCount).Offset(rCount - LastRowsCount)
        End With
    End Function
    
    Function GetRangeColumns( _
        ByVal SourceRange As Range, _
        SourceColumns()) _
    As Variant
    
        Dim scLo As Long: scLo = LBound(SourceColumns)
        Dim scUp As Long: scUp = UBound(SourceColumns)
        Dim scJag(): ReDim scJag(scLo To scUp)
        
        Dim Data(), scrg As Range, rCount As Long, sc As Long
        
        With SourceRange.Areas(1)
            rCount = .Rows.Count
            If rCount = 1 Then ReDim Data(1 To 1, 1 To 1)
            For sc = scLo To scUp
                Set scrg = .Columns(SourceColumns(sc))
                If rCount = 1 Then Data(1, 1) = scrg.Value Else Data = scrg.Value
                scJag(sc) = Data
            Next sc
        End With
        
        ReDim Data(1 To rCount, 1 To scUp - scLo + 1)
        
        Dim r As Long, dc As Long
        
        For sc = scLo To scUp
            dc = dc + 1
            For r = 1 To rCount
                Data(r, dc) = scJag(sc)(r, 1)
            Next r
        Next sc
        
        GetRangeColumns = Data
    
    End Function
    

    The Form Code

    • This basic form code was copied from the page UserForm1.Show, a must-read, which is an article about user forms by the SO legend Mathieu Guindon.

    • The form has two buttons: OkButton and CancelButton.

    Option Explicit
    
    Private cancelled As Boolean
     
    Public Property Get IsCancelled() As Boolean
        IsCancelled = cancelled
    End Property
     
    Private Sub OkButton_Click()
        Hide
    End Sub
     
    Private Sub CancelButton_Click()
        OnCancel
    End Sub
     
    Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
        If CloseMode = VbQueryClose.vbFormControlMenu Then
            Cancel = True
            OnCancel
        End If
    End Sub
     
    Private Sub OnCancel()
        cancelled = True
        Hide
    End Sub
    

    The Form Calling Code

    • It is expected that you'll add the two command buttons (rename appropriately) and a list box to the form.
    • In a standard module (not the user from module) you can use the following code.
    Sub UserFormTest()
        
        Dim Data(): Data = GetLastRowColumns
        
        With New UserForm1 ' adjust!
            With .Controls("ListBox1") ' adjust!
                '.Clear
                '.ColumnWidths = "30;30;30;30"
                .ColumnCount = UBound(Data, 2)
                .List = Data
            End With
            .Show
            If Not .IsCancelled Then
                MsgBox "Selected the 'OK' button.", vbInformation
            Else
                MsgBox "Selected the 'Cancel' or the 'X' button.", vbExclamation
            End If
        End With
        
    End Sub
    

    The Worksheet Calling Code

    • It looks like you were playing around with a worksheet Active-X list box. If the list box is in another worksheet you can use the following code. It is a more compact version: it uses both helper functions, but not the main function.
    Sub WorksheetTest()
     
        ' Define constants.
        Const SRC_NAME As String = "Sheet1"
        Const DST_NAME As String = "Sheet2"
        Const DST_LIST_BOX_NAME As String = "ListBox1"
        Const LAST_ROWS_COUNT As Long = 5
        Dim SRC_COLS(): SRC_COLS = Array("A", "B", "D", "G")
        
        ' Reference the Source worksheet ('sws').
        Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
        Dim sws As Worksheet: Set sws = wb.Sheets(SRC_NAME)
        
        ' Reference the Source Data range ('srg').
        Dim srg As Range
        With sws.Range("A1").CurrentRegion ' Source Table Range (has headers)
            Set srg = .Resize(.Rows.Count - 1).Offset(1) ' no headers
        End With
        
        ' Using the 'RefLastRows' function, reference the last rows ('slrg').
        Dim slrg As Range: Set slrg = RefLastRows(srg, LAST_ROWS_COUNT)
        If slrg Is Nothing Then Exit Sub ' not enough rows
        
        ' Using the 'GetRangeColumns' function, return the values from the last rows
        ' in a 2D array ('Data').
        Dim Data(): Data = GetRangeColumns(slrg, SRC_COLS)
        
        ' Populate the list box ('lst') in the Destination worksheet ('dws')
        ' with the values from the 2D array ('Data').
        
        Dim dws As Worksheet: Set dws = wb.Sheets(DST_NAME)
    
        Dim lst As MsForms.ListBox
        Set lst = dws.OLEObjects(DST_LIST_BOX_NAME).Object
    
        With lst
            '.Clear
            .ColumnCount = UBound(Data, 2)
            .List = Data
        End With
        
    End Sub