Rabu, 29 Februari 2012

Re: [ExcelVBA] Re: LISTBOX

 

Hi Ralph

The code at the moment goes into the userform which contains the Listbox1 control and you run it with the F5 key when the cursor is in the code.

As this is work in progress I am not sure how Jim intends to fire it off. In due course it would be fired by a Macro button or event handler somewhere. 

By the way, when I looked at my own post the format was OK, but in the reply to me (and others) indents in the code look like ">         Â". Also these As (hatted A) are scattered throughout  the text. 
Can anyone explain this or even provide a workround ? I am using Yahoo Mail.  

Regards

Derek Turner +++

>________________________________
> From: Ralph <ralph.gregory@skaino.co.uk>
>To: ExcelVBA@yahoogroups.com
>Sent: Wednesday, 29 February 2012, 10:59
>Subject: [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]
>>
>
>
>
>
>

[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