PDA

View Full Version : a userform question



lior03
02-19-2007, 12:52 AM
hello all
i have a workbook with 1454 macros.it's time to get the macro box -alt+f11,sort out.
i want to get a userform with a list box of all my macros.secondlly i want to be able to type a letter like c or s and get a list of all macro who's name begin with that letter.
is it possible?
thanks

mdmackillop
02-19-2007, 01:23 AM
As a starter, look here (http://www.vbaexpress.com/forum/showthread.php?t=10391&highlight=list+all+macros) for some code to get a list of your macros.

johnske
02-19-2007, 04:17 AM
hello all
i have a workbook with 1454 macros.it's time to get the macro box -alt+f11,sort out.
i want to get a userform with a list box of all my macros.secondlly i want to be able to type a letter like c or s and get a list of all macro who's name begin with that letter.
is it possible?
thanks
If you've got 1454 macros I don't think a userform is the best option to display them Moshe. Try this instead as a starter, it lists them alphabetically on a worksheet and there's event code added so you can navigate to the macro...

EDIT: Sorry, forgot. You'll need to add a reference to Microsoft Visual Basic for Applications Extensibility 5.3...

Private Sub AddReference()
Dim Reference As Object
With ThisWorkbook.VBProject
For Each Reference In .References
If Reference.Description Like "Microsoft Visual Basic for Applications Extensibility*" Then Exit Sub
Next
.References.AddFromGuid "{0002E157-0000-0000-C000-000000000046}", 5, 3
End With
End Sub


Sub ListProcedures()

Dim N As Long, Count As Long, FirstLine As Long
Dim FirstProc As String, LastProc As String, ActiveBook As String
Dim Component As VBComponent
Dim OpenBook As Workbook
Dim Cell As Range

ActiveBook = ActiveWorkbook.Name
If ActiveBook = ThisWorkbook.Name Then
Set OpenBook = ThisWorkbook
Else
Set OpenBook = ActiveWorkbook
End If

Application.ScreenUpdating = False
Application.EnableEvents = False
Workbooks.Add (xlWBATWorksheet)
On Error Resume Next '< next line errors out for ThisWorkbook
ActiveSheet.Name = "Procedures used in " & ActiveBook
On Error GoTo 0
ActiveWindow.DisplayHeadings = False
Cells.Clear
Cells.Font.Size = 8
With Rows(1).Font
.Size = 9
.Bold = True
.ColorIndex = 9
.Underline = xlUnderlineStyleSingle
End With

N = 2
For Each Component In OpenBook.VBProject.VBComponents
Range("A" & N) = Component.Name
With Component.CodeModule
Count = .CountOfDeclarationLines + 1
Do Until Count >= .CountOfLines
Range("B" & N) = .ProcOfLine(Count, vbext_pk_Proc)
Count = Count + .ProcCountLines(.ProcOfLine _
(Count, vbext_pk_Proc), vbext_pk_Proc)
If Count < .CountOfLines Then N = N + 1
Loop
End With
N = N + 1
Next

'//sort procedures alphabetically\\
For Each Cell In Range("A2", "A" & LastRowInColumn("B"))
If Cell <> Empty And Cell.Offset(0, 1) <> Empty Then
FirstProc = Cell.Offset(0, 1).Address
LastProc = Cell.End(xlDown).Offset(-1, 1).Address
If Range(FirstProc, LastProc).Cells.Count > 1 Then
Range(FirstProc, LastProc).Select
Selection.Sort Key1:=Range(FirstProc), MatchCase:=False, Orientation:=xlTopToBottom
End If
End If
Next

'insert event procedure in this new workbook
With ActiveWorkbook.VBProject.VBComponents("Sheet1").CodeModule
FirstLine = .CreateEventProc("SelectionChange", "Worksheet") + 1
.InsertLines FirstLine + 1, " Dim N As Long, ThisBook As Workbook"
.InsertLines FirstLine + 2, " Set ThisBook = ActiveWorkbook"
.InsertLines FirstLine + 3, " If Target.Row = 1 Then Exit Sub"
.InsertLines FirstLine + 4, " 'close any visible modules"
.InsertLines FirstLine + 5, " On Error Resume Next '< already minimized"
.InsertLines FirstLine + 6, " For N = 1 To Workbooks(""" & ActiveBook & """).VBProject.VBComponents.Count"
.InsertLines FirstLine + 7, " Application.VBE.Windows(N).WindowState = 1 '< vbext_ws_Minimize"
.InsertLines FirstLine + 8, " Next"
.InsertLines FirstLine + 9, " 'view a procedure"
.InsertLines FirstLine + 10, " On Error GoTo SelectModule '< next line errors out for Class mods"
.InsertLines FirstLine + 11, " If Target <> Empty Then"
.InsertLines FirstLine + 12, " Workbooks(""" & ActiveBook & """).Activate"
.InsertLines FirstLine + 13, " Application.Goto Target.Text"
.InsertLines FirstLine + 14, " End If"
.InsertLines FirstLine + 15, " ThisBook.Activate"
.InsertLines FirstLine + 16, " Exit Sub"
.InsertLines FirstLine + 17, "SelectModule:"
.InsertLines FirstLine + 18, " ThisBook.Activate"
.InsertLines FirstLine + 19, " On Error Resume Next"
.InsertLines FirstLine + 20, " If Target.Column = 1 Or Target.Column = 2 Then"
.InsertLines FirstLine + 21, " 'select a module"
.InsertLines FirstLine + 22, " Application.ScreenUpdating = False"
.InsertLines FirstLine + 23, " ActiveCell.Rows.EntireRow.Columns(1).Select"
.InsertLines FirstLine + 24, " If Selection = Empty Then"
.InsertLines FirstLine + 25, " Do Until Selection <> Empty"
.InsertLines FirstLine + 26, " ActiveCell.Offset(-1, 0).Activate"
.InsertLines FirstLine + 27, " Loop"
.InsertLines FirstLine + 28, " End If"
.InsertLines FirstLine + 29, " 'view a module"
.InsertLines FirstLine + 30, " Workbooks(""" & ActiveBook & """).VBProject.VBComponents _"
.InsertLines FirstLine + 31, " (Selection).CodeModule _"
.InsertLines FirstLine + 32, " .CodePane.Show"
.InsertLines FirstLine + 33, " End If"
End With
[A1] = "COMPONENT NAME"
[B1] = "PROCEDURES"

With [C1]
.Value = "(Select Component or Procedure to View Code)"
.Select
End With

Columns.AutoFit
With Application
.VBE.MainWindow.Visible = False
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub


Public Function LastRowInColumn(Column As String, Optional Sheet As String) As Long
If Sheet = "" Then Sheet = ActiveSheet.Name
LastRowInColumn = Sheets(Sheet).Range(Column & Rows.Count).End(xlUp).Row
End Function

lior03
02-19-2007, 05:56 AM
hello
i found a macro that list all procedures in a workbook on a sheet.i try to load it in a userform to a combo box.

Sub updatelistofmacro()
Dim row As Integer
For row = 1 To 1500
UserForm11.ComboBox1.AddItem Sheets("projects").Cells(row, 3)
Next row
End Sub


why can i update my list?
thanks

mdmackillop
02-19-2007, 11:42 AM
Hi Moshe,
Use List rather than looping through individual entries

Private Sub UserForm_Initialize()
UserForm1.ComboBox1.List = Sheets(1).Range(Cells(1, 1), _
Cells(Rows.Count, 1).End(xlUp)).Value
End Sub