Codes VBA
Codes VBA
Codes VBA
W X Y Z end
Excel Macros (VBA) tips for beginners. I do not use macros that have too many
lines of codes as this may confuse beginers. I remembered when I started learning
macro programming and going to sites by Chip Pearson & John Walkenbach and
started seeing stars instead of VB!!!. Simplified macros are used for easy
understanding for people like YOU and ME. By the way by, I am trained to be an
Accountant and not a programmer. I hope the this site gets you started in Macro
Programming & Good Luck.
Sub Auto_Open()
Msgbox "Hello"
End Sub
This code would be located in the module. However if you use the second method, the
code must be in the workbook (double click "This Workbook" in the explorer window).
Click on the drop down list (that says General) and select Workbook. Click on the drop
down list (that says declarations) and select Open.
Sub Count()
myCount = Selection.Rows.Count 'Change Rows to Columns to count columns
MsgBox myCount
End Sub
The next macro counts the number of sheets instead. Refer to Protecting all sheets
macro which uses this method.
Sub Count2()
myCount = Application.Sheets.Count
MsgBox myCount
End Sub
Sub TwoLines()
MsgBox "Line 1" & vbCrLf & "Line 2"
End Sub
Sub CloseAll()
Application.DisplayAlerts = False
myTotal = Workbooks.Count
For i = 1 To myTotal
ActiveWorkbook.Close
Next i
End Sub
Sub CopyRange()
Range("A1:A3").Copy Destination:=ActiveCell
End Sub
To copy from a range in another sheet (eg Sheet3) to the active cell you need to change
the code to;
Sheets("sheet3").Range("A1:A3").Copy Destination:=ActiveCell
Sub Count()
mycount = Range("a1") + 1
Range("a1") = mycount
End Sub
Sub ContentChk()
If Application.IsText(ActiveCell) = True Then
MsgBox "Text" 'replace this line with your macro
Else
If ActiveCell = "" Then
MsgBox "Blank cell" 'replace this line with your macro
Else
End If
If ActiveCell.HasFormula Then
MsgBox "formula" 'replace this line with your macro
Else
End If
If IsDate(ActiveCell.Value) = True Then
MsgBox "date" 'replace this line with your macro
Else
End If
End If
End Sub
Sub DelEmptyRow()
Rng = Selection.Rows.Count
ActiveCell.Offset(0, 0).Select
Application.ScreenUpdating = False
For i = 1 To Rng
If ActiveCell.Value = "" Then 'You can replace "" with 0 to delete rows with 'the value zero
Selection.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If
Next i
Application.ScreenUpdating = True
End Sub
Sub DeleteNames()
Dim NameX As Name
For Each NameX In Names
ActiveWorkbook.Names(NameX.Name).Delete
Next NameX
End Sub
Sub DupsRed()
Application.ScreenUpdating = False
Rng = Selection.Rows.Count
For i = Rng To 1 Step -1
myCheck = ActiveCell
ActiveCell.Offset(1, 0).Select
For j = 1 To i
If ActiveCell = myCheck Then
Selection.Font.Bold = True
Selection.Font.ColorIndex = 3
End If
ActiveCell.Offset(1, 0).Select
Next j
ActiveCell.Offset(-i, 0).Select
Next i
Application.ScreenUpdating = True
End Sub
Sub Email()
ActiveWorkbook.SendMail recipients:="julsn@yahoo.com"
End Sub
Application.ScreenUpdating = False
You need to set the screen updating back to true at the end of the macro.
Sub GoHere()
Application.Goto Reference:="Sales" OR Range("Sales").Select
End Sub
Sub FirstSheet()
Sheets(1).Select
End Sub
Sub Go2sheet()
myShts = ActiveWorkbook.Sheets.Count
For i = 1 To myShts
myList = myList & i & " - " & ActiveWorkbook.Sheets(i).Name & " " & vbCr
Next i
Dim mySht As Single
mySht = InputBox("Select sheet to go to." & vbCr & vbCr & myList)
Sheets(mySht).Select
End Sub
Sub HideSheet()
Sheet1.Visible = xlSheetVeryHidden
End Sub
If you hide your sheets this way, users will not be able to unhide them using the menus.
Only using VB codes will be able to display the sheets again.
Sub HideExcel()
Application.Visible = False
End Sub
Input Box [27/10/2001] (back to top)
When you need to get input from users, you can use input boxes. This macro will ask for
the user's name and will display a message "Hello" plus the user's name.
Sub GetInput()
Dim MyInput 'This line of code is optional
MyInput = InputBox("Enter your name")
MsgBox ("Hello ") & MyInput
End Sub
Sub InsertRow()
Dim Rng
Rng = InputBox("Enter number of rows required.")
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(Rng - 1, 0)).Select
Selection.EntireRow.Insert
End Sub
Here the macro uses the range technique where a range is first selected and then
subsequently rows are inserted.
Sub JoinText()
myCol = Selection.Columns.Count
For i = 1 To myCol
ActiveCell = ActiveCell.Offset(0, 0) & ActiveCell.Offset(0, i)
ActiveCell.Offset(0, i) = ""
Next i
End Sub
Sub Killfile()
Dim MyFile As String 'This line of code is optional
On Error Resume Next 'On hitting errors, code resumes next code
MyFile = "c:\folder\filename.xls"
kill MyFile
End Sub
Wildcards can be use. Replace the file name with * (use with caution!).
Sub Killed()
Application.DisplayAlerts=False
ThisWorkbook.ChangeFileAccess xlReadOnly
Kill ThisWorkbook.FullName
ThisWorkbook.Close False
End Sub
Sub LowerCase()
Dim cell As Range
For Each cell In Selection.Cells
If cell.HasFormula = False Then
cell = LCase(cell)
End If
Next
End Sub
Sub LastRow()
Range("a65536").End(xlUp).Offset(1, 0).Select
End Sub
Sub MyMessage()
MsgBox "This macro is created by Julian"
MsgBox "The icon is different", vbInformation
MsgBox "The top title is different", vbExclamation, "Julian's Tips"
End Sub
Sub myForm()
UserForm.show vbModeless
End Sub
Sub Down()
ActiveCell.Offset(1, 0).Select
End Sub
Sub up()
ActiveCell.Offset(-1, 0).Select
End Sub
Sub Right()
ActiveCell.Offset(0, 1).Select
End Sub
Sub Left()
ActiveCell.Offset(0, -1).Select
End Sub
Sub ProtectSheet()
Dim Password 'This line of code is optional
Password = "1234"
ActiveSheet.Protect Password, True, True, True
End Sub
Sub UnProtectSheet()
Password = "1234"
ActiveSheet.Unprotect Password
End Sub
Sub protectAll()
Dim myCount 'This line of code is optional
Dim i 'This line of code is optional
myCount = Application.Sheets.Count
Sheets(1).Select 'This line of code selects the 1st sheet
For i = 1 To myCount
ActiveSheet.Protect
If i = myCount Then
End
End If
ActiveSheet.Next.Select
Next i
End Sub
Sub RandomNo()
Randomize
MyNumber = Int((49 - 1 + 1) * Rnd + 1)
MsgBox ("The random number is ") & (MyNumber)
End Sub
In this case the random numbers that will be generate is between 1 and 49.
Sub RngName()
Selection.Name = "myRange"
End Sub
Resizing a Range [3/9/2002] (back to top)
Resizing a range is simple. You can apply this to inserting rows & columns or to expand
a selected range. This macro resizes the range to 7 rows by 7 columns.
Sub ResizeRng()
Selection.Resize(7,7).Select
End Sub
Sub Round()
ActiveCell = Application.round(ActiveCell, -3)
End Sub
This code round to the nearest 1000 thus giving the value 12000.
Sub Macro1()
Msgbox("This is Macro1")
Call Macro2 'This calls for Macro2 to run
End Sub
Sub Save()
ActiveWorkbook.Save
End Sub
Sub SaveName()
ActiveWorkbook.SaveAs Filename:="C:\MyFile.xls"
End Sub
Sub SaveAll()
myFile = ActiveWorkbook.Name
ActiveWorkbook.Save
ActiveWindow.ActivateNext
Do While myFile <> ActiveWorkbook.Name
ActiveWorkbook.Save
ActiveWindow.ActivateNext
Loop
End Sub
Level 2 - The next step is to force the user to enable your macro when opening your file.
The best way is to use a macro to hide the important sheets (see Hiding sheets) when
saving your file. Upon opening the file, a macro will be used to unhide these sheets. If the
user disables the macros when opening the worksheet, they will not be able to view your
worksheet unless they allow the macro to run.
Level 3 - The final step is to put an expiry date for your worksheet or your macro.
However this has a draw back as the user may change the system date of the computer to
by pass the step. Alternatively you can use a counter (Refer Counter Macro) to allow a
fixed number of access to your worksheet or macro. Here you need to save the counter
value each time the file or macro is used. Upon reaching the defined limit, disable the
macro or disable the access of your worksheet.
The steps mentioned above are not 100% fool proof. But it will keep normal users out but
not hackers and crackers. Here I will not supply the code as this can be lengthy and may
be difficult to understand but I believe these steps may be useful to some of you out there.
Sub SelAllData()
Application.ScreenUpdating = False
Dim myLastRow As Long
Dim myLastColumn As Long
Range("A1").Select
On Error Resume Next
myLastRow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
myLastColumn = Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column
myLastCell = Cells(myLastRow, myLastColumn).Address
myRange = "a1:" & myLastCell
Application.ScreenUpdating = True
Range(myRange).Select
End Sub
Sub myEdit()
MsgBox Left("abcd", 2) 'Displays 2 characters from Left
MsgBox Right("abcd", 2) 'Displays 2 characters from Right
MsgBox Len("abcd") 'Displays number of characters
End Sub
Textbox1 = Val(textbox2)+Val(textbox3)
Sub timer()
Application.Wait Now + TimeValue("00:00:10")
MsgBox ("10 sec has elasped")
End Sub
Sub TitleCase()
Dim cell As Range
For Each cell In Selection.Cells
If cell.HasFormula = False Then
cell = Application.Proper(cell)
End If
Next
End Sub
Sub TopLeft()
ActiveCell.Select
With ActiveWindow
.ScrollColumn = ActiveCell.Column
.ScrollRow = ActiveCell.Row
End With
End Sub
Sub UpperCase()
Dim cell As Range
For Each cell In Selection.Cells
If cell.HasFormula = False Then
cell = UCase(cell)
End If
Next
End Sub
YesNo = MsgBox("This macro will ... Do you want to continue?", vbYesNo + vbCritical, "Caution")
Select Case YesNo
Case vbYes
'Insert your code here if Yes is clicked
Case vbNo
'Insert your code here if No is clicked
End Select
Sub NextVisibleRow()
ActiveCell.Offset(1, 0).Select
Do While ActiveCell.EntireRow.Hidden = True
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Take note that there are many ways of writing a macro which produces the same effect. Macro
programming takes a lot of imagination and creativity. There is no one correct method. As I do not
have a programming background, my macros may not be very efficient but I have used a simple
approach and this is a good start to learn macro programming for those who are new in this area. I
have also simplified the macros so that it would be easier for you to understand.
I do get lots of email from all over the world saying that this is a great site for beginners. Truly this is
encouraging & I THANK YOU ALL for your support. Please note that I may not answer all your
emails as I get more emails than I can cope with & I'm pretty busy with work too. I will try to answer
some of them if I can but it may take some time. Also note that I do not provide the full source codes
but I will try to point you in the right direction. Once again a big Thank You for visiting my site.
In today's highly competitive job market, success will determined by your ability in fully
utilising the power of computers. Build that competitive edge over the others. Personal
training available in SETIA ALAM, SETIA ECO, Petaling Jaya, Subang Jaya,
Puchong & Bandar Baru Bangi areas. Learn at the comfort of your own home and at
your own pace. For more details email julian.excel@gmail.com Don't get left behind in
the IT world. On site training available for small organisations. One day crash course
training available too.
http://www.angelfire.com/biz7/julian_s/julian/julians_macros.htm
http://www.anthony-vba.kefra.com/vba/excelvba-simulation.htm#Double_Sorting_-
_The_secret_of
http://www.mrexcel.com/archive/VBA/index.html