FREE Excel STUFF
SearchSearch Excel Content
Excel Help. Popular
NEW! Multiple Excel Search & Links
Excel Formulas
Excel Macros
Excel Newsletter
PRODUCTS
Up to $139.00 FREE!
Categories & SearchSearch for software
Excel Templates
Excel Add-ins
Excel Training
More....
OTHER
Excel Development


Excel VBA Code For Excel UserForms & Controls


NEW! More Books..
Add to Google advanced search! Free Help!

Add Excel Answers & Search To Your Google Toolbar Details

Current Special! Complete Excel Excel Training Course for Excel 97 - Excel 2003, only $145.00. $59.95 Instant Buy/Download, 30 Day Money Back Guarantee & Free Excel Help for LIFE!

Back to: Excel Custom Function/Formulas . Got any Excel/VBA Questions? Free Excel Help

Add a unique and sorted list to a ListBox:

Sub SortAndRemoveDupes()
	Dim rListSort As Range, rOldList As Range
	Dim strRowSource As String

	'Clear Hidden sheet Column A ready for list
	Sheet1.Range("A1", Sheet1.Range("A65536").End(xlUp)).Clear
  
 
	'Set range variable to list we want
	Set rOldList = Sheet2.Range("A1", Sheet2.Range("A65536").End(xlUp))

	'Use AdvancedFilter to copy the list to Column A _
	of the hidden sheet and remove all dupes
	rOldList.AdvancedFilter Action:=xlFilterCopy, _
		CopyToRange:=Sheet1.Cells(1, 1), Unique:=True
               
	'Set range variable to the new non dupe list
	Set rListSort = Sheet1.Range("A1", Sheet1.Range("A65536").End(xlUp))
	
	'Sort the new non dupe list
    With rListSort
		.Sort Key1:=.Cells(2, 1), Order1:=xlAscending, Header:=xlYes, _
		OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    End With
    
	'Parse the address of the sorted unique items
	strRowSource = Sheet1.Name & "!" & Sheet1.Range _
	("A2", Sheet1.Range("A65536").End(xlUp)).Address
   
	Sheet1.Range("A1") = "New Sorted Unique List"
		With UserForm1.ListBox1
			'Clear old ListBox RowSource
			.RowSource = vbNullString
			'Parse new one
			.RowSource = strRowSource
  		End With
  
End Sub

LisboxSort.zip
Download an example of the above code!.


Prevent a User From Closing A UserForm via the top X

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
	If CloseMode = 0 Then Cancel = True
End Sub

Use The Enter Key To Add Text From a TextBox

This code will keep adding text from a TextBox on a UserForm to the cell below the last entry in Column A each time the Enter Key is Pressed.

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, _
                                     ByVal Shift As Integer)
	If KeyCode = 13 Then
		Sheet1.Range("A65536").End(xlUp).Offset(1, 0) = TextBox1
		TextBox1 = vbNullString
    End If
End Sub

Validate a TextBox For Numbers Only Entry

Private Sub TextBox1_Change()
	If TextBox1 = vbNullString Then Exit Sub
    	If Not IsNumeric(TextBox1) Then
 			MsgBox "Sorry, numbers only"
     		TextBox1 = vbNullString
    	End If
End Sub

Validate a TextBox For Text Only Entry

Note we cannot use the Change Event for text as they may enter something like 123Area, this would mean the Change Event would fire as soon as they typed a number.

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
	If TextBox1 = vbNullString Then Exit Sub
    	If IsNumeric(TextBox1) Then
     		MsgBox "Sorry, text only"
     		TextBox1 = vbNullString
     		Cancel = True 'Stops them leaving with numbers in the TextBox
    	End If
End Sub

Add a Minimize/Maximize Button to a UserForm

Here is a nice simple method you can use for a Minimize/Maximize Button on a UserForm. Just add a ToggleButton to the top of the UserForm

Dim dWidth As Double

Private Sub ToggleButton1_Click()
	If ToggleButton1.Value = True Then
		Me.Height = Me.Height * 0.25
    Else
       	Me.Height = dWidth
    End If
End Sub

Private Sub UserForm_Initialize()
    dWidth = Me.Height
End Sub

Excel Dashboard Reports & Excel Dashboard Charts 50% Off

Special! Free Choice of Complete Excel Training Course OR Excel Add-ins Collection on all purchases totaling over $64.00. ALL purchases totaling over $150.00 gets you BOTH! Purchases MUST be made via this site. Send payment proof to special@ozgrid.com 31 days after purchase date.


Instant Download and Money Back Guarantee on Most Software

Excel Trader Package Technical Analysis in Excel With $139.00 of FREE software!

Add to Google Search Tips FREE Excel Help

Microsoft ® and Microsoft Excel ® are registered trademarks of Microsoft Corporation. OzGrid is in no way associated with Microsoft