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]
>
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