fixing code rowsource in listbox through all sheets

H

Hasson

Active Member
Joined
Apr 8, 2021
Messages
390
Office Version
  1. 2016
Platform
  1. Windows
hi
I have this code to show dat in listbox a based on active sheet.
VBA Code: 
Private Sub UserForm_Initialize()
   MyRowSource = "A2:d" & Str(activesheet.Cells.SpecialCells(xlCellTypeLastCell).Row)
    MyRowSource = Replace(MyRowSource, " ", "")
    ListBox1.RowSource = MyRowSource
    Next
End Sub

I try showing data in list box throught all sheets but so far not work

Code: 
Private Sub UserForm_Initialize()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets

   MyRowSource = "A2:d" & Str(ws.Cells.SpecialCells(xlCellTypeLastCell).Row)
    MyRowSource = Replace(MyRowSource, " ", "")
    ListBox1.RowSource = MyRowSource
    Next
End Sub
any help to fix it ?
 
Sort by date Sort by votes

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
It can't be empty. This causes error.
Did your set "SetListBoxColumnWidths" procedure in the end of
UserForm_Initialize() preocedure? Something like this...
VBA Code: 
Private Sub UserForm_Initialize()
    
    Call AllRows
    Call MergeAndSumUnique
'display in the listbox
    ListBox1.ColumnCount = 7
    ListBox1.List() = vA3
'set listbox ColumnWidths
    Call SetListBoxColumnWidths
    
End Sub
 
Upvote 0
this is the whole code I use it
VBA Code: 
Dim ws As Worksheet
Dim vA(), vA2(), vA3()
Dim vSum As Double
Dim vR As Long, vN As Long, vN2 As Long, vC As Long



Private Sub TextBox1_Change()

End Sub

Private Sub UserForm_Initialize()
     Call SetListBoxColumnWidths

    Call AllRows
    Call MergeAndSumUnique
'display in the listbox
    ListBox1.ColumnCount = 7
    ListBox1.List() = vA3
 
End Sub

Sub AllRows()
   
    Dim vRAll As Long
'calculate the final size
    For Each ws In Worksheets
         vR = ws.Cells(Rows.Count, "A").End(xlUp).Row - 1
         vRAll = vRAll + vR
    Next ws
'resize array
    ReDim vA(1 To vRAll, 1 To 7)
'fill array
    vC = 1
    For Each ws In Worksheets
        vR = ws.Cells(Rows.Count, "A").End(xlUp).Row
        For vN = 2 To vR
            vA(vC, 1) = ws.Cells(vN, 1)
            vA(vC, 2) = ws.Cells(vN, 2)
            vA(vC, 3) = ws.Cells(vN, 3)
            vA(vC, 4) = ws.Cells(vN, 4)
            vA(vC, 5) = ws.Cells(vN, 5)
            vA(vC, 6) = ws.Cells(vN, 6)
            vA(vC, 7) = ws.Cells(vN, 7)
            vC = vC + 1
        Next vN
    Next ws
    vC = 0
   
End Sub



Private Sub sh1_Change()
       
    Set ws = Sheets("sh1")
    Call OneSheetRows
    ListBox1.List() = vA3
    If vR = 1 Then ListBox1.Clear
   
End Sub

Private Sub fgj1_Change()
   
    Set ws = Sheets("fgj1")
    Call OneSheetRows
    ListBox1.List() = vA3
    If vR = 1 Then ListBox1.Clear
   
End Sub

Private Sub zxc_Change()

    Set ws = Sheets("zxc")
    Call OneSheetRows
    ListBox1.List() = vA3
    If vR = 1 Then ListBox1.Clear
   
End Sub

Sub MergeAndSumUnique()

    Dim vD, vMR As Long
'create one dimensional array from column "B"
    ReDim vA2(1 To UBound(vA))
    For vN = 1 To UBound(vA)
        vA2(vN) = vA(vN, 2)
    Next vN
'create aray with unique values from column "B"
    With CreateObject("Scripting.Dictionary")
        For Each vD In vA2
            If Not .exists(vD) Then
                .Add vD, .Count
            End If
        Next vD
'create two dimensional array with unique values
        vA2 = Application.Transpose(.keys)
'resize new two dimensional array
        ReDim vA3(1 To .Count, 1 To 7)
    End With
'fill final array
    For vN = 1 To UBound(vA2)
        For vN2 = 1 To UBound(vA)
'but before, compare unique items with items in the column "B"
'if match, sum duplicate values in the column "D"
            If vA2(vN, 1) = vA(vN2, 2) Then
                If vMR = 0 Then vMR = vN2
                vSum = vSum + vA(vN2, 7)
'separating text from number
                vInv = Split(vA(vN2, 5), "-")(0)
                vNInv = Split(vA(vN2, 5), "-")(1)
'create string from numbers
                vS = vS & vNInv & ","
            End If
        Next vN2
'edit final string
        vS = vInv & "-" & Left(vS, Len(vS) - 1)
        vA3(vN, 1) = vA(vMR, 1)
        vA3(vN, 2) = vA(vMR, 2)
        vA3(vN, 3) = vA(vMR, 3)
        vA3(vN, 4) = vA(vMR, 4)
'display new string
        vA3(vN, 5) = vS
        vA3(vN, 6) = vA(vMR, 6)
        vA3(vN, 7) = vSum
        vSum = 0
        vMR = 0
        vS = ""
    Next vN

End Sub
Sub SetListBoxColumnWidths()
 
'don't forget to add label on the userform
    Dim vMaxWidth  As Long, vW As String
 
    With Label1
 'copy some listbox properties to label properties
        .FontSize = ListBox1.FontSize
        .Font.Bold = ListBox1.Font.Bold
 'set label to autosize mode
        .AutoSize = True
 'make label to be in one line
        .WordWrap = False
 'optional, hide label
        .Top = -100
    End With
 'loop through listbox items
    With ListBox1
        For vN = 0 To .ColumnCount - 1
            For vN2 = 0 To .ListCount - 1
 'use label to calculate max width
                Label1.Caption = .List(vN2, vN)
 'keep max width
                If Label1.Width > vMaxWidth Then _
                    vMaxWidth = Label1.Width
            Next vN2
        Next
'set max width to each column
        For vN = 1 To .ColumnCount
            vW = vW & vMaxWidth + 10 & ","
        Next vN
         MsgBox vW

' trim ColumnWidths and display...
        .ColumnWidths = Left(vW, Len(vW) - 1)
    End With

End Sub
and shows me empty message after message is gone . the erorr shows again
 
Upvote 0
Try to put "Call SetListBoxColumnWidths" procedure on the down.
VBA Code: 
Private Sub UserForm_Initialize()
    
    Call AllRows
    Call MergeAndSumUnique
'display in the listbox
    ListBox1.ColumnCount = 7
    ListBox1.List() = vA3
'set listbox ColumnWidths
    Call SetListBoxColumnWidths
    
End Sub
 
Upvote 0
yes. all of things are good . thanks . as you know when select one of them option buttons I can't return showing all of data in list box as in run userform from the first time . so I add a new option button calls ALL to merge all of data in all of the sheets I try add this to option buttons ALL but not work
idea , please?
VBA Code: 
Private Sub ALL_Click()
 Call AllRows
 ListBox1.ColumnCount = 7
    ListBox1.List() = vA3
End Sub
 
Upvote 0
When you calling "AllRows" procedure the data are still in the array "vA",
so if you want to fill listbox with this data before procedure "Call MergeAndSumUnique",
just in the end of the procedure "AllRows" fill listbox with array "vA".
VBA Code: 
Sub AllRows()
   
    Dim vRAll As Long
'calculate the final size
    For Each ws In Worksheets
         vR = ws.Cells(Rows.Count, "A").End(xlUp).Row - 1
         vRAll = vRAll + vR
    Next ws
'resize array
    ReDim vA(1 To vRAll, 1 To 7)
'fill array
    vC = 1
    For Each ws In Worksheets
        vR = ws.Cells(Rows.Count, "A").End(xlUp).Row
        For vN = 2 To vR
            vA(vC, 1) = ws.Cells(vN, 1)
            vA(vC, 2) = ws.Cells(vN, 2)
            vA(vC, 3) = ws.Cells(vN, 3)
            vA(vC, 4) = ws.Cells(vN, 4)
            vA(vC, 5) = ws.Cells(vN, 5)
            vA(vC, 6) = ws.Cells(vN, 6)
            vA(vC, 7) = ws.Cells(vN, 7)
            vC = vC + 1
        Next vN
    Next ws
    vC = 0
'display in the listbox
    ListBox1.ColumnCount = 7
    ListBox1.List() = vA
    
End Sub
 
Upvote 0
If you want to show all merged row create new procedure "AllMergedRows"
and call it in the initialize procedure or in the button click procedure.
VBA Code: 
Private Sub CommandButton1_Click()
    
    Call AllMergedRows
    
End Sub

Sub AllMergedRows()

    Call AllRows
    Call MergeAndSumUnique
'display in the listbox
    ListBox1.ColumnCount = 7
    ListBox1.List() = vA3
    
End Sub

Private Sub UserForm_Initialize()
     
    Call AllMergedRows
    Call SetListBoxColumnWidths
 
End Sub
 
Upvote 0
great ! thanks again for your huge help .
um ... I tought I can deal with this code . but it seems needing more much to learn vba . and sorry every time I ask more requiremen
the project almost barely finish . I follow your code how merge the differnt invoices number by comma .I try appling the same thing in COL 6 in listbox
like this cus105,106 I add this
VBA Code: 
 vInv = Split(vA(vN2, 5), "-")(0)
  vNInv = Split(vA(vN2, 5), "-")(1)
  vInv = Split(vA(vN2, 6), "-")(0)
   vNInv = Split(vA(vN2, 6), "-")(1)

to Sub MergeAndSumUnique()
and chang this
Code: 
vA3(vN, 6) = vA(vMR, 6)
to this
Code: 
vA3(vN, 6) = vs
but not succedd
 
Upvote 0
In the meantime, you can update "SetListBoxColumnWidths" in this way...
VBA Code: 
Sub SetListBoxColumnWidths()
 
'don't forget to add label on the userform
    Dim vMaxWidth  As Long, vW As String
 
    With Label1
 'copy some listbox properties to label properties
        .FontSize = ListBox1.FontSize
        .Font.Bold = ListBox1.Font.Bold
 'set label to autosize mode
        .AutoSize = True
 'make label to be in one line
        .WordWrap = False
 'optional, hide label
        .Top = -100
    End With
 'loop through listbox items
    With ListBox1
        For vN = 0 To .ColumnCount - 1
            For vN2 = 0 To .ListCount - 1
 'use label to calculate max width
                Label1.Caption = .List(vN2, vN)
 'keep max width
                If Label1.Width > vMaxWidth Then _
                        vMaxWidth = Label1.Width
            Next vN2
            vW = vW & CStr(vMaxWidth + 10) & ","
            vMaxWidth = 0
        Next vN
' trim ColumnWidths and display...
        .ColumnWidths = Left(vW, Len(vW) - 1)
    End With

End Sub
 
Upvote 0
thanks , but nothing changes .see the pic in lastrow in listbox and highlighted rows in sheet
1.PNG
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Solved
Vba combobox- date format
Replies
1
Views
476
DanteAmor
DanteAmor
A
  • Question
updating code selected items based enter a new or change data
Replies
0
Views
309
abdelfattah
A
C
  • Question
Changing the Rowsource of a userform Listbox with each change in the Listbox selection
Replies
0
Views
249
chazrab
C
P
  • Question
Data not copying fully into ListBox2
Replies
0
Views
107
Patriot2879
P
C
  • Question
Getting the cell address of a sheet cell from the Change Event of a Listbox1's code n = Listbox1.Listindex
Replies
5
Views
286
Legacy 143009
L

Forum statistics

Threads
1,214,872
Messages
6,122,025
Members
449,060
Latest member
LinusJE

Share this page

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