Sabtu, 25 Februari 2012

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

__._,_.___
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