Sub frist()
'date is 28 sep 2011 Declaration of variables
'example1
Dim a As Integer
'declaring a as integer
'example2
Dim x As Boolean, y As Date
'example3
Dim a As Integer
Dim s As String
'example4
Dim m As Integer, n
Dim i, j As Integer
'example 5
Dim o
Dim o As Variant
End Sub
Sub frist_macro()
'
' frist_macro Macro
' recording my frist macro
'
' Keyboard Shortcut: Ctrl+j
'
ActiveCell.FormulaR1C1 = "my name is ravikanth "
Range("L12").Select
End Sub
---------------------------------------------------------------------------------------------------------------------------------
Sub fristpro()
'date is 28 sep 2001 writing my frist script
Dim a As Integer
a = Cells(1, 1)
MsgBox a
End Sub
Basic input and output functions
Sub abc()
MsgBox "how are you?", vbYesNo, "about u"
End Sub
things in square brackets are optional
Sub abc()
MsgBox "how are you?", vbYesNo + vbQuestion, "about u"
End Sub
----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
input box
Sub abc()
Dim a As Integer
a = InputBox("enter a number", "reading a no")
MsgBox a
End Sub
enter any no and click ok
--------------------------------------------------------------------------------------------------------------
Sub abc()
Dim a As Integer
a = InputBox("enter a number", "reading a no")
MsgBox "the value in a is " & a
End Sub
--------------------------------------------------------------------------------------------------------------------
Sub abc()
Dim a As Integer
a = InputBox("enter a number", "reading a no")
Cells(1, 1) = a
End Sub
------------------------------------------------------------------------------------------------------------------------
Sub abc()
Dim a As Integer
a = InputBox("enter a number", "reading a no")
a = a ^ 2
Cells(1, 1) = a
End Sub
--------------------------------------------------------------------------------------------------------------------------
Sub abc()
Dim a As Integer
a = InputBox("enter a number", "reading a no")
a = a ^ 2
Range("b100") = a
End Sub
IIF-inline if-
Sub abc()
Dim a As Integer
a = 2
Cells(1, 1) = IIf(a > 5, "a is greater then 5", _
"a is not greater then 5")
End Sub
If conditions
Sub abc()
Dim a As Integer
a = 2
If a > 5 Then Cells(1, 1) = "greater than 5"
End Sub
if false nothing because else not given
Sub abc()
Dim a As Integer
a = 2
If a > 5 Then 'true statment
Cells(1, 1) = "greater than 5"
Else 'false statment
Cells(1, 1) = "a is not greater then 5"
End If
End Sub
Sub abc()
Dim a As Integer, b As Integer
a = 30: b = 10
If a > b Then 'true statment
Range("a1") = a
Else 'false statment
Range("a1") = b
End If
End Sub
Elseif
Sub abc()
Dim a As Integer, b As Integer, c As Integer
Dim big As Integer
a = 30: b = 10: c = 40
If a > b And a > c Then
big = a
ElseIf b > c Then
big = b
Else
big = c
End If
Range("a1") = big
End Sub
Select variable(select case)
Sub abc()
Dim wc As Integer, msg As String
wc = InputBox("enter week-code (1-7):", "weekcode")
Select Case wc
Case 1: msg = "sun"
Case 2: msg = "mon"
Case 3: msg = "Tue"
Case 4: msg = "wen"
Case 5: msg = "thr"
Case 6: msg = "fri"
Case 7: msg = "sat"
Case Else: MsgBox "wrong week-code"
End Select
Cells(1, "b") = msg
End Sub
click ok
Sub abc()
Dim wc As Integer, msg As String
wc = InputBox("enter week-code (1-7):", "weekcode")
Select Case wc
Case 1,75 to 90,111, 222, is >1000 : msg = "sun" 'a series of random value and values based on conditions
Case 2: msg = "mon"
Case 3: msg = "Tue"
Case 4: msg = "wen"
Case 5: msg = "thr"
Case 6: msg = "fri"
Case 7: msg = "sat"
Case Else: MsgBox "wrong week-code"
End Select
Cells(1, "b") = msg
End Sub
Sub abc()
Dim samt As Double, comm As Double
samt = InputBox("enter sales amount:")
Select Case samt
Case Is >= 1000000: comm = samt * 0.5
Case Is >= 750000: comm = samt * 0.25
Case Is >= 250000: comm = samt * 0.15
Case Else: comm = 0
End Select
Cells(1, "a") = comm
End Sub
Active Properties
Sub abc()
MsgBox ActiveWorkbook.Name
MsgBox ActiveSheet.Name
MsgBox ActiveCell.Address
MsgBox ActiveCell.Row
MsgBox ActiveCell.Column
End Sub
,
,
,
Loops
Sub abc()
Dim i As Integer
For i = 1 To 10
Debug.Print i
Next
End Sub
-----------------------------------------------------------------------------------------------------------------------------
Sub abc()
Dim i As Integer
For i = 1 To 10 Step 2
Debug.Print i
Next
End Sub
-----------------------------------------------------------------------------------------------------------------------------
Sub abc()
Dim i As Integer
For i = 10 To 1 Step -1
Debug.Print i
Next
End Sub
Sub abc()
Dim i As Integer
For i = 1 To 10
Cells(i, "a") = i
Next
End Sub
XL VBA Object model
Sub abc()
For Each wb In Workbooks
Debug.Print wb.Name
Next
End Sub
Sub abc()
For Each sh In ActiveWorkbook.Sheets
Debug.Print sh.Name
Next
End Sub
While wend(Loops)
Sub abc()
Dim i As Integer
While i < 10
i = i + 1
Debug.Print i
Wend
End Sub
Do--------------------------while/until loop
Sub abc()
Dim i As Integer
Do
i = i + 1
Debug.Print i
Loop While i < 10
End Sub
Sub abc()
Dim i As Integer
Do
i = i + 1
Debug.Print i
Loop Until i = 10
End Sub0
Built in functions
?abs(-234.45)
234.45
?asc("A")
65
?chr(65)
A
?fix(237.567)
237
?round(234.567)
235
?round(234.467)
234
?round(234.567,2)
234.57
?len("abc def")
7
?left("abc def",2)
ab
?right("abc def",4)
def
?strreverse("abc def")
fed cba
?ucase("abcdf")
ABCDF
?lcase("ASDFGHJKL")
asdfghjkl
?mid("abc def",1,3)
abc
?mid("abcdef",2,4)
bcde
?instr("abcdefgbc","bc")
2
?instr(3,"abcdefgbc","bc")
8
?replace("jack n jue","j","bl")
black n blue
?strconv("we are vbas",vbProperCase )
We Are Vbas
?date
10/3/2011
?format(date,"dddddd")
Monday, October 03, 2011
?format(date,"dd-mmm-yyyy")
03-Oct-2011
?format(date,"dd-mmmm-yyyy")
03-October-2011
?day(date)
3
?month(date)
10
?year(date)
2011
?time
12:24:16 PM
?weekday(sunday)
7
?weekday(#05-oct-2011#)
4
?weekdayname(weekday(#05-oct-2011#))
Wednesday
?weekdayname(weekday(#24-mar-1983#))
Thursday
?datediff("d",#24-mar-1983#,#06-oct-2011#)
10423
?datediff("m",#24-mar-1983#,#06-oct-2011#)
343̓
?datediff("yyyy",#24-mar-1983#,#06-oct-2011#)
28
?datediff("h",#24-mar-1983#,#06-oct-2011#)
250152
?datediff("n",#24-mar-1983#,#06-oct-2011#)
15009120
?datediff("s",#24-mar-1983#,#06-oct-2011#)
900547200
Sub av()
For Each c In Range("b3", "c10")
i = i + 1
c.Value = i
Next
End Sub
Selection of Range of cells
range("a1")="target"
range("a1:a10").Clear
range("a1","a10").Select
range("a1, a10").Select
range("a:a").Select
range("1:1").Select
range("a:c").Select
range("1:3").Select
range("a:c,f:g").Select
range("a1","c5").Select
range("a1,g1").Select
range("1:3,5:8").select
range(cells(1,1),cells(10,2)).Select
range("b3","c10").Cells(2,1).select
range("b3","c10")(10).select
range("b3","c10").Cells(5,2).select
range("b3","c10").Cells.Select
range("b3","c10")(17).select
range("b3","c10").Cells(0,1).select
range("b3","c10").Cells(-1,1).select
range("a1").activate
range("a1").addcomment"samplecomment"
range("a1").addcomment"createdon" & now
range("a1").Comment.Visible=True
range("a1").Comment.text"the new comment"
range("a1").Comment.Delete
range("a1:b10").Interior.Colorindex=3
Sub abc()
For i = 1 To 56
Cells(i, "a").Interior.ColorIndex = i
Next
End Sub
1 | |
2 | |
3 | |
4 | |
5 | |
6 | |
7 | |
8 | |
9 | |
10 | |
11 | |
12 | |
13 | |
14 | |
15 | |
16 | |
17 | |
18 | |
19 | |
20 | |
21 | |
22 | |
23 | |
24 | |
25 | |
26 | |
27 | |
28 | |
29 | |
30 | |
31 | |
32 | |
33 | |
34 | |
35 | |
36 | |
37 | |
38 | |
39 | |
40 | |
41 | |
42 | |
43 | |
44 | |
45 | |
46 | |
47 | |
48 | |
49 | |
50 | |
51 | |
52 | |
53 | |
54 | |
55 | |
56 | |
cells(1,"a").interior.color=rgb(255,255,100)
Sub abc()
With Range("a1:b10").Font
.Bold = True
.Italic = True
.Underline = True
.Name = "arial"
.Size = "100"
.FontStyle = "bold italic"
.ColorIndex = 3
.Superscript = True
.Subscript = True
.Strikethrough = True
End With
End Sub
range("a1").Characters (2,1).Font.Superscript=true
Sub abc()
Range("a1:b10").Copy Range("e6")
End Sub
Sub abc()
Range("a1:b10").Copy
Range("e6").PasteSpecial
End Sub
Option Base 1
Sub av()
Dim a(3) As Integer '1 to 3
'storing values in an arry
a(1) = Range("b1")
a(2) = Range("b2")
a(3) = Range("b3")
'getting values from an array
Range("c1") = a(1)
Range("c2") = a(2)
Range("c3") = a(3)
End Sub
Sub av()
Dim a(4) As Integer '0 to 4
'storing values in array
For i = LBound(a) To UBound(a)
a(i) = Range("b" & i + 1)
Next
'getting values from a array
For i = LBound(a) To UBound(a)
Range("c" & i + 1) = a(i)
Next
End Sub
Sub av()
Dim a(4) As Integer
a(1) = 200
For Each x In a
Debug.Print x
Next
End Sub
Integer array will assign zero to all their elements by default but string arrays will contain blank text by default
0
200
0
0
0
Sub av()
Dim a() As Integer
'array without anysize/dimentions are called dynamic array
Dim n As Integer
n = InputBox("enter no of cells") 'given 9
ReDim a(n) 'with redim statment a dynamic array size can be increased or decreased any no of times
'reading from xl and writing in to an array
For i = LBound(a) To UBound(a)
a(i) = Range("a" & i + 1)
Next
ReDim Preserve a(n + 5) 'the preserve statment is optinal it is used to keep the previous values in a dyn arry unerased
For Each x In a
Debug.Print x
Next
End Sub
1
2
3
4
5
6
7
8
9
10
0
0
0
0
0
Sub av()
Dim a(4, 3) As Integer '4rows and 3 column
Dim r As Integer, c As Integer 'storing data into multidim array
For r = 1 To UBound(a, 1) 'for r=1 to 4
'this is a nested loop r1c1, r1c2,r1c3,r1c4 row 1 completed then row 2 r2c1, r2c2,r2c3,r2c4
For c = 1 To UBound(a, 2) 'for c=1 to 3
a(r, c) = Cells(r, c) 'a(1,1)=cells(1,1)
Next
Next
'getting data from a multidim array
For r = 1 To 4
For c = 1 To 3
Cells(r + 5, c + 4) = a(r, c)
Next
Next
End Sub
Sub av()
Dim a
a = Array("10", "20", "30", "40")
MsgBox a(o)
End Sub
Sub av()
Dim a 'assigning a range to variant
a = Range("a1:c4")
MsgBox a(2, 2) 'returns the value of 2nd row 2nd col in the array
End Sub
Sub av()
Dim a 'assigning a range to variant
a = Range("a1:c4")
MsgBox a(2, 2) 'returns the value of 2nd row 2nd col in the array
a(2, 2) = "Ronald" 'assigning a variant to a range
Range("a1:c4") = a
End Sub
Sub av()
Application.ScreenUpdating = False
Dim t
t = Now
For i = 1 To 100
For j = 1 To 56
Range("a1").Interior.ColorIndex = j
Next
Next
MsgBox DateDiff("s", t, Now)
Application.ScreenUpdating = False
End Sub
Sub abc()
Dim fs, f
Set fs = CreateObject("scripthing.filesystemobject")
Set f = fs.createtextfile("E:\Documents and Settings\Administrator\My Documents\Ravikanth\Excelvbatextfile.txt")
f.writeline "this is the 1st line"
f.writeline "this is the 2nd line"
End Sub
Sub abc()
Dim fs, f
Set fs = CreateObject("scripting.filesystemobject")
Set f = fs.opentextfile("c:\abc.txt",1)
Dim s As String
Dim i As Integer
While Not f.atendofline 'end of the LAST line
i = i + 1
s = f.readline
Range("a" & i) = s
Wend
End Sub
Sub abc()
Dim fs, f
Set fs = CreateObject("scripting.filesystemobject")
Set f = fs.opentextfile("c:\abc.txt", 2)
f.writeline "this is 4th line"
End Sub
Sub abc()
Dim fs, f
Set fs = CreateObject("scripting.filesystemobject")
Set f = fs.opentextfile("c:\abc.txt", 8)
f.writeline "this is 5th line"
End Sub
Sub abc()
'read data from a textfile,split& write in excel into diff column
Dim fs, f
Set fs = CreateObject("scripting.filesystemobject")
Set f = fs.opentextfile("c:\abc.txt")
'set col heading in excel
Range("a1") = "Emp ID"
Range("b1") = "Emp Name"
Range("c1") = "City"
Dim i As Integer
i = 1
Dim s As String
While Not f.atendofline
i = i + l
s = f.readline
Dim a
a = Split(s, ",")
Dim x As Integer
For x = LBound(a) To UBound(a)
Cells(i, x + 1) = a(x)
Next
Wend
End Sub
Sub abc()
Dim fpath As String
fpath = "E:\Documents and Settings\Administrator\My Documents\Ravikanth\Excel"
Dim fs, f, fl
Set fs = CreateObject("scripting.filesystemobject")
Set f = fs.getfolder(fpath)
Set fl = f.Files
Debug.Print fl.Count
For Each x In fl
If Right(x.Name, 3) = "xls" Then
Workbooks.Open (fpath & "\" & x.Name)
End If
Next
End Sub
Sub abc()
Dim fpath As String
'fpath = "E:\Documents and Settings\Administrator\My Documents"
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
fpath = .SelectedItems(1)
End With
MsgBox fpath
End Sub
Sub abc()
Dim fpath As String
fpath = "E:\Documents and Settings\Administrator\My Documents"
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
fpath = .SelectedItems(1)
End With
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = True
.Filters.Clear
.Filters.Add "image files", "*.jpg,*.bmp", 1
.Filters.Add "excel files", "*.xls,*.xlsx", 2
.Show
For Each f In .SelectedItems
MsgBox f
Next
End With
End Sub
Sub filesystemmacro()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim fpath As String
fpath = "E:\Documents and Settings\Administrator\My Documents\Ravikanth\Excel\fold1"
Dim fpath2 As String
fpath2 = "E:\Documents and Settings\Administrator\My Documents\Ravikanth\Excel\fold2"
Dim fs, f, fc 'frist folder
Dim fs2, f2, fc2 'second folder
Dim wbk As Workbook, wbk2 As Workbook 'to work with 2 workbooks
Set fs = CreateObject("scripting.filesystemobject")
Set fs2 = CreateObject("scripting.filesystemobject")
Set f = fs.getfolder(fpath) 'frist folder
Set f2 = fs2.getfolder(fpath2) 'second folder
Set fc = f.Files 'files ref from folder1
Set fc2 = f2.Files 'files ref from folder2
For Each f In fc 'looping through files in folder1
Debug.Print f.Name 'name
Debug.Print fpath & "\" & f.Name 'fullpath
If UCase(Right(f.Name, 3)) = "xls" Then
Set wbk = Workbooks.Open(fpath & "\" & f.Name)
Dim matchfound As Boolean
For Each x In fc2 'looping through folder2
If UCase(Right(x.Name, 8)) = UCase(Right(wbk.Name, 8)) Then
Debug.Print x.Name
Set wbk2 = Workbooks.Open(fpath2 & "\" & x.Name)
matchfound = True
Exit For
End If
Next x
If matchfound = True Then
wbk.Worksheet(1).Activate
wbk.Worksheets(1).Columns("a:a").Select '1st column
Selection.Insert shift:=xlToRight 'inserting new column
Range("b1:h20").Copy 'instead of H20 make use of used range
wbk2.Worksheets(2).Activate 'copy data in to sheet2
Range("a2").PasteSpecial
wbk2.Close True
Set wbk = Nothing
matchfoun = False
Else
wbk.Close False
Set wbk = Nothing 'free the obj variables
End If
End If
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "data copied from workbooks"
End Sub
Sub av()
MsgBox ActiveSheet.UsedRange.Address
Dim ws As Worksheet
Set ws = Sheets("sheet1")
MsgBox ws.UsedRange.Rows.Count
MsgBox ws.UsedRange.Columns.Count
MsgBox ws.UsedRange.Cells.Count
MsgBox ws.UsedRange.Cells(1, 1).Address
MsgBox ws.UsedRange.Cells(1, 1).Row
MsgBox ws.UsedRange.Cells(1, 1).Column
Dim rc As Long, cc As Long
rc = ws.UsedRange.Rows.Count
cc = ws.UsedRange.Columns.Count
MsgBox ws.UsedRange.Cells(rc, cc).Address
MsgBox ws.UsedRange.Cells(rc, cc).Row
MsgBox ws.UsedRange.Cells(rc, cc).Column
End Sub
No comments:
Post a Comment