Rabu, 29 Februari 2012

[ExcelVBA] Re: LISTBOX

 

Hi Derek I am trying to follow this and am a bit lost as to where I put the code...I created a new workbook and renamed a sheet Gages then put some data in etc then I created a user form with a listbox on it but now where does your code go and how do I run it....sorry if these are dumb questions but it is still a new world to me....

--- In ExcelVBA@yahoogroups.com, Derek Turner <g4swy@...> wrote:
>
> Hi All
>
> Here is my own code to do what Jim wants :- 
>
>
> ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
> '   Populate a multicolumn Listbox (with >10 columns) from an Excel range
> '   Derek Turner February 2012
> ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
> Private Sub UserForm_Initialize()
> Const FIND_I = "MPR0010"
> Const FIND_J = "T1"
> Const COLUMN_I = 9
> Const COLUMN_J = 10
> Const LISTBOXCOLUMNS = 17
> Const TITLEROW = 1
>
> Dim vSourceArray As Variant, vSubsetArray() As Variant
> Dim vSubsetRow(1 To LISTBOXCOLUMNS), clxSubsetRows As New Collection
> Dim nSourceRow As Long, nSubsetRow As Long, nSourceRowCount As Long, nListBoxColumn As Long
> '
>     vSourceArray = Worksheets("Gages").Range("a1").CurrentRegion.Value
>     nSourceRowCount = UBound(vSourceArray)
>     
>     For nSourceRow = 1 To nSourceRowCount
>         If nSourceRow = 
> TITLEROW  _
>          Or (vSourceArray(nSourceRow, COLUMN_I) = FIND_I _
>          And vSourceArray(nSourceRow, COLUMN_J) = FIND_J) Then
>             For nListBoxColumn = 1 To LISTBOXCOLUMNS
>                 vSubsetRow(nListBoxColumn) = vSourceArray(nSourceRow, nListBoxColumn)
>             Next nListBoxColumn
>             clxSubsetRows.Add vSubsetRow()
>         End If
>     Next nSourceRow
>     With clxSubsetRows
>         ReDim vSubsetArray(1 To .Count, 1 To LISTBOXCOLUMNS)
>         For nSubsetRow = 1 To .Count
>             For nListBoxColumn = 1 To LISTBOXCOLUMNS
>                 vSubsetArray(nSubsetRow, nListBoxColumn) = .Item(nSubsetRow)(nListBoxColumn)
>             Next nListBoxColumn
>         Next nSubsetRow
>     End With
>     With ListBox1
>         .ColumnCount = LISTBOXCOLUMNS
>         .ColumnWidths = "100;80;50;50;50;50;50;100;60;50;50;50;50;50;05;05;50"
>         .List = vSubsetArray
>     End With
> End Sub
> ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
>
> To test this you need to  put random stuff  into a range of 17 columns and as many rows as you like (I used 39,000) in a worksheet called "Gages", then populate a few cells in column I with "MPR0010" and  then "T1"  in  a few less cells in the corresponding rows in column J. Of course also you need Listbox1 in the Userform.
>
> This code is more complicated than expected because of yet another VBA bug. The Listbox control does not allow you fill more than 10 columns usingthe  .List(.ListCount - 1, nColumn)method that I used in my previous post. It errors. This is undocumented in the Help, so is a bug.  
>
>
> My first approach was to make a subset array from the matching rows but the problem there is that you can only Redim the rightmost dimension in a Redim statement (columns being in the rightmost). In the past I have coped with this with a double transpose method but I did not want to increase the number of code lines. I also tried a method that involved putting a large mainly blank subset array into the Listbox and then in a loop using RemoveItem to delete empty rows but this took too long (10 seconds for 39,000 rows)
>
> Therefore the method I used puts individual matching rows into a Collection and then in the last stage unpacks them into a rectangular array which populates the List property of the Listbox. Collections expand and contract dynamically without Re-Dim-ing.
>
> The code is written in a self documenting style. If anybody wants an explanation of any point I will be pleased to oblige. By the way I tested this with 480 columns. It works. I don't know how anybody could use a Listbox with 480 columns (let alone 17, Microsoft thinks 10 is too many) but it works with only a minor pause. 
>
> Comments invited please. 
>
> Regards
>
> Derek Turner +++
>
>
>
>
>
>
> From:JIMNEELY <jimneely@...>
> >
> >To: ExcelVBA@yahoogroups.com
> >Sent: Sunday, 26 February 2012, 4:28
> >Subject: [ExcelVBA] Re: LISTBOX
> >
> >
> > 
> >wow I fixed my problem. all i did was to start macro recording and went though the steps i wanted the program to do and it works here is the code.
> >
> >Private Sub UserForm_Initialize()
> >'Author : Jim Neely
> >'Macro Purpose: To populate a listbox with data from
> >' a worksheet range
> >Application.ScreenUpdating = False
> >Sheets("Gages").Select
> >Range("A2").Select
> >Selection.AutoFilter
> >ActiveSheet.Range("$A$1:$Q$905").AutoFilter Field:=9, Criteria1:="MR0008"
> >ActiveSheet.Range("$A$1:$Q$905").AutoFilter Field:=10, Criteria1:="T1"
> >Range("A1:Q905").Select
> >Selection.Copy
> >'Workbooks.Open Filename:="C:\Users\Lori\Desktop\awnc\ScratchWB.xlsx"
> >Sheets("Sheet3").Select
> >Range("A1").Select
> >ActiveSheet.Paste
> >Range("A2").Select
> >'Windows("Press Area - Master Gage File and Map.xlsm").Activate
> >Sheets("Gages").Select
> >Range("A78").Select
> >Application.CutCopyMode = False
> >Selection.AutoFilter
> >Range("A2").Select
> >'Windows("ScratchWB.xlsx").Activate
> >Sheets("Sheet3").Select
> >Dim lbtarget As msforms.ListBox
> >Dim rngSource As Range
> >'Set reference to the range of data to be filled
> >Set rngSource = Worksheets("sheet3").Range("A1:Q500")
> >'Fill the listbox
> >Set lbtarget = Me.ListBox3
> >With lbtarget
> >'Determine number of columns
> >.ColumnCount = 17
> >'Set column widths
> >.ColumnWidths = "100;80;50;50;50;50;50;100;60;50;50;50;50;50;05;05;50"
> >'Insert the range of data supplied
> >.List = rngSource.Cells.Value
> >End With
> >'Dim savechanges As Boolean
> >'savechanges = False
> >'Application.ActiveWindow.Close (savechanges)
> >Sheets("Map").Select
> >Application.ScreenUpdating = True
> >
> >End Sub
> >
> >--- In ExcelVBA@yahoogroups.com, Derek Turner <g4swy@> wrote:
> >>
> >> Hi Jim
> >>
> >> I am not sure about the problem as described in your later post, but this is a more simple way of doing what I think you are trying to achieve in your code below.
> >>
> >> Private Sub UserForm_Initialize()
> >> Dim nRow As Long
> >> Dim vArray As Variant
> >> Const LOOKFOR = "PR0010"
> >> '
> >>     vArray = Worksheets("Gages").Range("i1:k39000").Value
> >>     With ListBox1
> >>
> >>         .ColumnCount = 3
> >>         .ColumnWidths = "50"
> >>         For nRow = 1 To UBound(vArray)
> >>             If vArray(nRow, 1) = LOOKFOR Then
> >>                 .AddItem vArray(nRow, 1)
> >>                 .List(.ListCount - 1, 1) = vArray(nRow, 2)
> >>                 .List(.ListCount - 1, 2) = vArray(nRow, 3)
> >>             End If
> >>         Next nRow
> >>     End With
> >> End Sub
> >>
> >>
> >> It assumes you have a Listbox1 in the UserForm and is looking for a match in column i (which I populated with an arbitrary 38,000 random rows to test the speed), and picks up the items in columns j and k for the multi-column listbox. Notice it does not error if you set the ColumnCount to 2, it just ignores the item.
> >>
> >> Regards.
> >>
> >> Derek +++
> >>
> >>  
> >>
> >>
> >>
> >>
> >>
> >>
> >> >________________________________
> >> > From: JIMNEELY <jimneely@>
> >> >To: ExcelVBA@yahoogroups.com
> >> >Sent: Wednesday, 22 February 2012, 19:59
> >> >Subject: [ExcelVBA] Re: LISTBOX
> >> >
> >> >
> >> > 
> >> >
> >> >
> >> >--- In ExcelVBA@yahoogroups.com, "JIMNEELY" <jimneely@> wrote:
> >> >>
> >> >> I want a listbox to show items from a spreadsheet. The items have to be certain items so I was thinking a FIND would do the trick. but my main question to the group is this possible.
> >> >>
> >> >This might help. I am trying to fill a listbox with 3 columns based on a one find item. so i look at all "PR0008" and store the 3 columns in a array to later display in a listbox. Here is the code so far. It does not store the "DEPT" but instead the count.
> >> >Private Sub UserForm_Initialize()
> >> >Dim lb As msforms.ListBox
> >> >Dim rcArray() As String
> >> >Dim Dept As Integer
> >> >With Worksheets("Gages").Range("I2:I25")
> >> >Set D = .Find("PR0010", LookIn:=xlValues)
> >> >firstaddress = D.Address
> >> >Set D = .FindNext(D)
> >> >While D.Address <> firstaddress
> >> >Dept = Dept + 1
> >> >MsgBox Dept
> >> >MsgBox D
> >> >ReDim Preserve rcArray(1 To Dept)
> >> >rcArray(D) = D
> >> >Set D = .FindNext(D)
> >> >Wend
> >> >End With
> >> >
> >> >'Place the array in the listbox
> >> >Set lb = Me.ListBox1
> >> >With lb
> >> >.ColumnCount = 1
> >> >.ColumnWidths = "50"
> >> >.List = rcArray
> >> >End With
> >> >End Sub
> >> >
> >> >
> >> >
> >> >
> >> >
> >>
> >> [Non-text portions of this message have been removed]
> >>
> >
> >
> >
> >
> >
>
> [Non-text portions of this message have been removed]
>

__._,_.___
Recent Activity:
----------------------------------
Be sure to check out TechTrax Ezine for many, free Excel VBA articles! Go here: http://www.mousetrax.com/techtrax to enter the ezine, then search the ARCHIVES for EXCEL VBA.

----------------------------------
Visit our ExcelVBA group home page for more info and support files:
http://groups.yahoo.com/group/ExcelVBA

----------------------------------
More free tutorials and resources available at:
http://www.mousetrax.com

----------------------------------
.

__,_._,___

Tidak ada komentar:

Posting Komentar