fixing code rowsource in listbox through all sheets

H

Hasson

Active Member
Joined
Apr 8, 2021
Messages
387
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
The last update allows you to set each column on the minimum width,
previously allows you to set each column on the same(maximum)width.
About correction for a column 6 ...
You were close...
VBA Code: 
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)
                vInv2 = Split(vA(vN2, 6), "-")(0)   'add this
                vNInv2 = Split(vA(vN2, 6), "-")(1)   'add this
'create string from numbers
                vS = vS & vNInv & ","
                vS2 = vS2 & vNInv2 & ","   'add this
            End If
        Next vN2
'edit final string
        vS = vInv & "-" & Left(vS, Len(vS) - 1)
        vS2 = vInv2 & "-" & Left(vS2, Len(vS2) - 1)   'add this
        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) = vS2   'add this
        vA3(vN, 7) = vSum
        vSum = 0
        vMR = 0
        vS = ""
        vS2 = ""   'and this
    Next vN

End Sub
 
Upvote 0

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
excellent ! I try learning , but not easy like me . I'm so begginer

to be honest nobody achieve what you did it . you have a big patience and I appreciate your assistance to complete my project

now you achieved about 99% from my project . it remains last step .I hope to acheive it when you have free time .

as you know in COL G contain QTY . I add two columns H(UNIT PRICE) , I(TOTAL) . I(TOTAL) =COLUMN H multiply (X) COL G so what I want when shows in list box should calculate averege values in COL 8 IN LIST BOX and the COL 9 should equal COL 7 multiply(x) COL 8.
if this is not clear I will attach picture to see values for item how should be .
 
Upvote 0
So, if I understand this should be complete final code.
If you have follow each step carefully you should be able to do correction according to your needs.
I hope you are learn some useful things.
You are graduate. Congratulation!?‍?;)
VBA Code: 
Dim ws As Worksheet
Dim vA(), vA2(), vA3()
Dim vR As Long, vC As Long

Private Sub UserForm_Initialize()
     
    Call AllMergedRows
    Call SetListBoxColumnWidths
 
End Sub

Sub AllMergedRows()

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

Sub AllRows()
    
    vRAll = 0
'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

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 9)
    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)
'another value calculation ( columns  8 & 9 )
                vSum2 = vSum2 + vA(vN2, 7)
'count the number of the calculations
                vNC = vNC + 1
'separating text from number
                vInv = Split(vA(vN2, 5), "-")(0)
                vNInv = Split(vA(vN2, 5), "-")(1)
                vInv2 = Split(vA(vN2, 6), "-")(0)
                vNInv2 = Split(vA(vN2, 6), "-")(1)
'create string from numbers
                vS = vS & vNInv & ","
                vS2 = vS2 & vNInv2 & ","
            End If
        Next vN2
'edit final string
        vS = vInv & "-" & Left(vS, Len(vS) - 1)
        vS2 = vInv2 & "-" & Left(vS2, Len(vS2) - 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) = vS2
        vA3(vN, 7) = vSum
'display calculation in the specific decimal format
        vA3(vN, 8) = Format(vSum2 / vNC, "0.00")
        vA3(vN, 9) = Format(vA3(vN, 7) * vA3(vN, 8), "0.00")
        vSum = 0
        vSum2 = 0
        vNC = 0
        vMR = 0
        vS = ""
        vS2 = ""
    Next vN

End Sub

Sub OneSheetRows()

    vR = ws.Cells(Rows.Count, "A").End(xlUp).Row
    If Not vR = 1 Then
'resize array
        ReDim vA(1 To vR - 1, 1 To 7)
        vC = 1
 'fill array
        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
        vC = 0
        Call MergeAndSumUnique
  End If

End Sub

Sub SetListBoxColumnWidths()
 
'don't forget to add label on the userform
 
    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 & vMaxWidth + 10 & ","
            vMaxWidth = 0
        Next vN
' trim ColumnWidths and display...
        .ColumnWidths = Left(vW, Len(vW) - 1)
    End With

End Sub

Sub FillListBox()

    Call OneSheetRows
    ListBox1.List() = vA3
    If vR = 1 Then ListBox1.Clear
    
End Sub

Private Sub sh1_Change()

    Set ws = Sheets("sh1")
    Call FillListBox

End Sub

Private Sub fgj1_Change()

    Set ws = Sheets("fgj1")
    Call FillListBox

End Sub

Private Sub zxc_Change()

    Set ws = Sheets("zxc")
    Call FillListBox

End Sub

Private Sub CommandButton1_Click()
    
    Call AllMergedRows
    
End Sub
 
Upvote 0
Solution
wow! you're super great ! . who accepts every time mod the code for every new requirments nobody, but you did it . I don't exaggerate .

you gave me a big favor . thanks so much for achieved to this project . and dedicate your time to complete this project ;):)(y)
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Solved
Vba combobox- date format
Replies
1
Views
474
DanteAmor
DanteAmor
A
  • Question
updating code selected items based enter a new or change data
Replies
0
Views
308
abdelfattah
A
C
  • Question
Changing the Rowsource of a userform Listbox with each change in the Listbox selection
Replies
0
Views
242
chazrab
C
P
  • Question
Data not copying fully into ListBox2
Replies
0
Views
83
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
278
Legacy 143009
L

Forum statistics

Threads
1,214,516
Messages
6,119,980
Members
448,934
Latest member
audette89

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