|
SOME IMPORTANT FUNCTIONS FOR
EXCEL
CLICK one of the option
below
Get the name of excel file
Function MyName() As
String
MyName =
ThisWorkbook.Name
End Function
Create New Excel Workbook
FileName = "testing"
XL_File = FilePath
& "\" & FileName & ".xlsx"
Set
MyXL =
CreateObject("Excel.Application")
'Create the Excel Application Object.
MyXL.Workbooks.Add
'Create new Excel Workbook
MyXL.Worksheets(1).Name = SheetName
MyXL.Worksheets(SheetName).Range("A1") = "Generating New Excel
File"
MyXL.Application.Visible =
True
'Show the Excel sheet in Excel Window.
MyXL.Worksheets(1).SaveAs
(XL_File)
'Save the Excel File
MyXL.Quit
'Close the Workbook , MyXL.Quit OR
MyXL.Workbooks(1).Close
MyXL.Application.Visible = True
Set MyXL =
Nothing
Create CSV file
CSV_File = FilePath
& "\" &
FileName
Workbooks.Add
ActiveWorkbook.SaveAs
FileName:=CSV_File, FileFormat:=xlCSV, CreateBackup:=False
Open WORKBOOK
FileName = "" & userInput & ".xlsx
"
STRName = userInput
Workbooks.Open FilePath & "\" &
FileName & ".xlsx"
Copy sheet to other WORKBOOK
Windows(FirstWorkBookName).Activate
Sheets(Sheet1).Select
Sheets(Sheet1).Copy
Before:=Workbooks(SecondWorkBookName).Sheets("Sheet3")
Find empty column in specific row or
column
iRow = ws.Cells(Rows.Count, iCol).End(xlUp).Offset(1,
0).Row 'find empty line of specific
row
LastCol1 = Cells(2, 255).End(xlToLeft).Column
LastRow = Cells(65536, 2).End(xlUp).Row
LastCol =
Cells(2, 255).End(xlToLeft).Column
Defining different variables
Array : ReDim FeatureList(100) As
String
String: Dim CheckBoxSelected As
String
Integer:Dim i As Integer
Loop in EXCEL
WHILE LOOP
Do While
(FeatureList(i) <>
"")
i = i + 1
Loop
IF
CONDITION
If (R = 0)
Then
NewStreamlineArray(j) =
Data
StreamlineArray = StreamlineArray +
1
End If
FOR LOOP
For j = 1
To
StreamlineArray
If (NewStreamlineArray(j) <> "")
Then
tempString =
tempString & vbCrLf & j & ". " &
NewStreamlineArray(j)
End If
Next
Give Title to chart
Sub TitleCharts()
With
Worksheets("Dashboard").ChartObjects(1).Chart
.HasTitle =
True
.ChartTitle.Text = "Defect
Raised"
End
With
End Sub
DELETE SHEET
Sub DeleteSheet(strSheetName As
String)
' deletes a sheet named strSheetName in the active
workbook
Application.DisplayAlerts =
False
Sheets(strSheetName).Delete
Application.DisplayAlerts = True
End Sub
Writing Formulae and autofill
Range("L" &
tempCount).Select
ActiveCell.FormulaR1C1 =
"=SUM(R[-" & tempSumFinalCount &
"]C:R[-2]C)"
Range("L" &
tempCount).Select
Selection.AutoFill
Destination:=Range("L" & tempCount & ":" & "U" &
tempCount), Type:=xlFillDefault
ActiveCell.Offset(1, 0).Select
tempCalString =
"=if(R[-3]C = ""
"",NA(),SUM(R[-3]C22:R[-3]C)/COUNT(R[-3]C22:R[-3]C))"
ActiveCell.FormulaR1C1 = tempCalString
ActiveCell.FormulaR1C1 =
_
"=SUMPRODUCT(--(INDIRECT(""'""&RC3&""'!"" &
""$M$1:$M$1000"")='Test
Summary'!R3C),--(INDIRECT(""'""&RC3&""'!"" &
""$K$1:$K$1000"")='Test Summary'!RC23))"
get location of cursor
dynamically
StartEnd = ActiveCell.Offset(1,
2).Address
EndEnd = ActiveCell.Offset(FinalCount + 3, 2).Address
Show Form
UserForm1.Show 'to show form to
the user
Unload Me
'to remove form visible to the
user
Msgbox with options
Sub
Checkpoint()
'vbOkOnly, vbYesNo and vbNo are constants automatically available
within
VBA
If MsgBox("Do You want to Close excel file. ", vbYesNo,
"Checkpoint") = vbYes
Then
Application.Quit ' close
Excel!!
End If
End Sub
Get value from specific
row,col
FilePathIndex =
"D11"
FilePath = Range(FilePathIndex).Value
OR
tmpLocation =
Cells(iterate, 18).Value
Check File already exist
Function
TestFileName()
Dim sPath As
String
sPath
= FilePath & "\" & FileName &
".csv"
If Dir(sPath) <> ""
Then
MsgBox ("File Name exist in the
path")
TestFileName =
1
Else
TestFileName =
0
End If
End
Function
Check Path provided is valid PATH
Function
TestFilePath()
Dim
rspCreate
If Not Dir(FilePath, vbDirectory) = vbNullString
Then
TestFilePath =
0
Else
MsgBox ("Directory Path does not
exist")
TestFilePath =
1
End
If
End
Function
Sub
BrowserFolder()
Dim
Path As
String
Path
=
GetFolder("C:\")
If
(Path = "My Computer" Or Path = "My Network Places" Or Path = "")
Then
MsgBox ("Location of Output file is NOT set correctly" & vbCrLf
& "Please Browse again, to set path
correctly")
Path
= "Location of Output
file"
End
If
Cells(11, 4) =
Path
End
Sub
Function GetFolder(strPath As String) As
String
Dim fldr As
FileDialog
Dim sItem As
String
Set
fldr =
Application.FileDialog(msoFileDialogFolderPicker)
With
fldr
.Title
= "Select a
Folder"
.AllowMultiSelect
=
False
.InitialFileName
=
strPath
If
.Show <> -1 Then GoTo
NextCode
sItem
=
.SelectedItems(1)
End
With
NextCode:
GetFolder =
sItem
Set
fldr =
Nothing
End
Function
Copy Sheet and Delete Row
Sub
CopySheet()
Cells.Select
Selection.Copy
Windows(FileName
&
".csv").Activate
Cells.Select
ActiveSheet.Paste
End
Sub
Sub
deleteRow(RowNo As
Integer)
Rows(RowNo
& ":" &
RowNo).Select
Application.CutCopyMode
=
False
Selection.Delete
Shift:=xlUp
End
Sub
Read each char of a word and populate in
temp array
x
=
Len(FileName)
ReDim
tempVal(x)
For
i = 0 To
x
tempVal(i)
= Mid(FileName, i + 1,
1)
Next
Split names
Function
splitName(ByVal fileName, ByVal
Separator)
Dim
Length As
Integer
Dim
avarSplit As
Variant
avarSplit
= Split(fileName,
Separator)
Length
=
UBound(avarSplit)
splitName
=
avarSplit(Length)
End
Function
call
by
:
SearchFiles
= splitName(objItem, "\")
Unzip file using Macros
Sub
UnZip(ByVal strTargetPath As String, ByVal Fname As
Variant)
Dim
oApp As
Object
Dim
FileNameFolder As
Variant
If
Right(strTargetPath, 1) <> Application.PathSeparator
Then
strTargetPath
= strTargetPath &
Application.PathSeparator
End
If
FileNameFolder
=
strTargetPath
Set
oApp =
CreateObject("Shell.Application")
oApp.Namespace(FileNameFolder).CopyHere
oApp.Namespace(Fname).items
End
Sub
call
by:
Call
UnZip(Path, Path & "\" & fileName)
Search specific file in
directory
Function
SearchFiles(ByVal FolderToSearch As String, Optional ByVal Extn As
String)
If
Right$(FolderToSearch, 1) <> "\" Then FolderToSearch =
FolderToSearch &
"\"
If
Not CBool(Len(Dir(FolderToSearch, vbDirectory))) Then Exit
Function
Dim
objFSO, objItem, objFolder As
Object
Dim
FilesList() As
String
Dim
CountFiles As
Long
Set
objFSO =
CreateObject("scripting.filesystemobject")
Set
objFolder =
objFSO.getfolder(FolderToSearch)
For
Each objItem In
objFolder.Files
SearchFiles
= splitName(objItem,
"\")
If
InStr(1, SearchFiles, Extn, vbTextCompare)
Then
GoTo
out
End
If
Next
out:
Set
objFolder =
Nothing
Set
objFSO =
Nothing
End
Function
call
by:
fileName
= SearchFiles(Path, ".zip")
Password protection and
unprotection
Sub
protectAll()
Dim
SheetNameList As
String
Dim
SheetNameListArray() As
String
Dim
i As
Integer
SheetNameList
= "2G_ADD@2G_Modify@2G_Rehome@2G_Delete@3G_Add@3G_Modify@3G_Rehome@3G_DAS@4G_Add@4G_Modify"
SheetNameListArray
= Split(SheetNameList,
"@")
Windows(NameTemplateGenerator).Activate
For
i = 0 To
9
uncoverRow2
(SheetNameListArray(i))
Cells(1,
1).Select
ActiveSheet.Protect
Password:="polarisisgreat", DrawingObjects:=True, Contents:=True,
Scenarios:=True
Next
End
Sub
Sub
UnprotectSheet(WorkingSheet As
String)
Sheets(WorkingSheet).Select
ActiveSheet.Unprotect
Password:="polarisisgreat"
protectRow2
Sheets(WorkingSheet).Select
ActiveSheet.Protect
Password:="polarisisgreat", DrawingObjects:=True, Contents:=True,
Scenarios:=True
Cells(1,
1).Select
End
Sub
Sub
protectRow2()
Cells.Select
Selection.Locked
=
False
Selection.FormulaHidden
=
False
Rows("1:2").Select
Selection.Locked
=
True
Selection.FormulaHidden
=
False
End
Sub
Sub
protectrowandColumn2()
Cells.Select
Selection.Locked
=
False
Selection.FormulaHidden
=
False
Range("1:2,G:H,K:K").Select
Selection.Locked
=
True
Selection.FormulaHidden
=
False
End
Sub
Get weekdays only
Sub
getdateweekendbreak(initialize As
String)
Dim
StartNo, EndNo, findDate,
weekdayR
Dim
z, Difference, countweekdays,
weekdayExist
Dim
NDate As
String
countweekdays
= 0
If
(initialize = "I")
Then
StartNo
=
DateValue(StartDate)
EndNo
=
DateValue(EndDate)
NoOfDays
= EndNo -
StartNo
NewDate
=
StartDate
NDate
=
StartDate
Difference
= EndNo -
StartNo
For
z = 1 To
Difference
weekdayExist
= Weekday(NDate,
2)
If
(weekdayExist = 6 Or weekdayExist = 7)
Then
GoTo
2
End
If
countweekdays
= countweekdays +
1
2
NDate
= DateAdd("d", 1,
NDate)
Next
GetWorkDay
= countweekdays +
1
Else
1
NewDate
= DateAdd("d", 1,
NewDate)
StartNo
=
DateValue(NewDate)
EndNo
=
DateValue(EndDate)
Diff
= EndNo -
StartNo
weekdayR
= Weekday(NewDate,
2)
If
(weekdayR = 6 Or weekdayR = 7)
Then
GoTo
1
End
If
End
If
End
Sub
InputBox to take value
NameInput= InputBox$("Please enter your Name")
Msgbox("Name of the user is " & NameInput")
Copy Files and Delete Folder
Sub copyAllFiles(ByVal
oldPath As String, ByVal newPath As
String)
Dim fs As
Object
Set fs =
CreateObject("Scripting.FileSystemObject")
fs.CopyFile oldPath & "\" & "*", newPath &
"\"
fs.DeleteFolder
oldPath
Set fs = Nothing
End Sub
Delete File in a folder
Sub DeleteFiles(ByVal
DelPath)
Dim FilestoDelete
As
String
FilestoDelete = DelPath &
"\*"
On
Error Resume
Next
Kill
FilestoDelete
On Error GoTo 0
End Sub
Line up charts
Sub
LineUpMyCharts()
Windows("" & STRName &
".xlsx").Activate
Sheets("Dashboard").Select
Dim
MyWidth, MyHeight, MyLeft, MyTop As
Single
Dim
tempVar As
Integer
Dim
iChtIx As Long, iChtCt As Long
iChtCt
=
ActiveSheet.ChartObjects.Count
For
iChtIx = 1 To
iChtCt
If
(iChtIx = 1)
Then
MyWidth
=
340
MyHeight
=
225
MyLeft
= 20 + 225 + 225 +
20
MyTop
= 50 + 225 +
10
End
If
If (iChtIx = 2)
Then
MyWidth
=
400
MyHeight
=
225
MyLeft
=
20
MyTop
= 50 + 225 + 10 + 220 +
15
End
If
next
End
Sub
Different Types of GRAPHS
PieExplodedGraph
Sub
PieExplodedGraph()
Dim
GraphData As String
Windows(""
& STRName &
".xlsx").Activate
ActiveSheet.Shapes.AddChart.Select
GraphData
= "'Test Summary'!$C$6:$C$" & FinalRowCount & ",'Test
Summary'!$H$6:$H$" &
FinalRowCount
ActiveChart.SetSourceData
Source:=Range(
_
GraphData)
ActiveChart.ChartType
=
xlPieExploded
ActiveChart.SeriesCollection(1).Select
ActiveChart.ApplyLayout
(6)
ActiveChart.SeriesCollection(1).DataLabels.Select
Selection.ShowValue
=
True
Selection.ShowPercentage
=
False
ActiveChart.ChartTitle.Text
= "Daily Test Execution
Status"
ActiveChart.PlotBy
=
xlColumns
End
Sub
RateGraph
Sub RateGraph(ByVal ColumnName As String,
ExpectedRow As Integer, CurrentRow As
Integer)
Dim
FormulaeString As
String
Dim RequiredRow
As Integer
RequiredRow
= CurrentRow + 1
Windows("" & STRName &
".xlsx").Activate
Sheets("Dashboard").Select
FormulaeString = "'Test Summary'!$W$3:$" &
ColumnName & "$3,'Test Summary'!$W$" & ExpectedRow &
":$" & ColumnName & "$" & ExpectedRow & ",'Test
Summary'!$W$" & CurrentRow & ":$" & ColumnName &
"$" & CurrentRow & ", 'Test Summary'!$W$" &
RequiredRow & ":$" & ColumnName & "$" &
RequiredRow
ActiveSheet.Shapes.AddChart.Select
ActiveChart.SetSourceData
Source:=Range( _
FormulaeString
_
)
ActiveChart.ChartType =
xlLine
ActiveChart.SeriesCollection(1).Name =
"Planned"
ActiveChart.SeriesCollection(2).Name =
"Current"
ActiveChart.SeriesCollection(3).Name =
"Required"
End Sub
PieGraph
Sub PieGraph(col1 As String, col2 As String, ChartName As
String)
Dim GraphData As
String
Windows("" & STRName &
".xlsx").Activate
Sheets("Dashboard").Select
ActiveSheet.Shapes.AddChart.Select
GraphData = " 'Test Summary'!$" & col1 & "$3:$" & col2
& "$3, 'Test Summary'!$" & col1 & "$" &
FinalRowCount + 2 & ":$" & col2 & "$" &
FinalRowCount + 2 &
""
ActiveChart.SetSourceData Source:=Range(
_
GraphData)
ActiveChart.ChartType
= xlPie
ActiveChart.SeriesCollection(1).Select
ActiveChart.ApplyLayout
(6)
ActiveChart.SeriesCollection(1).DataLabels.Select
If (ChartName = "Test Results")
Then
Selection.ShowValue
=
True
Selection.ShowPercentage
=
False
End
If
ActiveChart.ChartTitle.Text
= ChartName
ActiveChart.PlotBy = xlRows
End Sub
StackedColumnGraphDefect
TOP
Sub StackedColumnGraphDefect(ByVal SheetNamePaseed As String,
TitleofSheet As String, CheckGraph As String)
Dim
FormulaeString As String
Dim FinalRowGraph As Integer
If (CheckGraph = "DefRaise")
Then
FinalRowGraph = 6 +
NoOfDays
FormulaeString = "'" & SheetNamePaseed
& "'!$P$4:$U$4,'" & SheetNamePaseed & "'!$P$6:$U$"
& FinalRowGraph
Else
FinalRowGraph =
9
FormulaeString = "'" & SheetNamePaseed &
"'!$P$4:$T$4,'" & SheetNamePaseed & "'!$P$6:$T$" &
FinalRowGraph
End If
Windows("" & STRName &
".xlsx").Activate
Sheets("Dashboard").Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.SetSourceData
Source:=Range( _
FormulaeString
_
)
ActiveChart.ChartType =
xlColumnStacked
ActiveChart.Axes(xlValue).MinorUnit
= 1
End Sub
33
34
Copyright 2009 Kunal
Saxena Inc. All rights
reserved |