VBA Texts
VBA Texts
Sub Scenario8()
'Calculation happens in Excel
ActiveCell.Value = "=SUM(D3:D7)"
End Sub
Sub SCenario9()
' Calculation happens in VBA
ActiveCell.Value = WorksheetFunction.Sum(Range("D3:D7"))
End Sub
Sub SCenario10()
If WorksheetFunction.Sum(Range("D3:D7")) > 50000 Then
MsgBox "Great Deal"
Else
MsgBox "Ok Deal"
End If
End Sub
Sub SCenario11()
ActiveCell.Value = "=SUMIF(A3:A7,C12,D3:D7)"
End Sub
Sub SCenario12()
ActiveCell.Value = WorksheetFunction.SumIf(Range("A3:A7"), ActiveCell.Offset(0,
-1), Range("D3:D7"))
End Sub
Sub SCenario13()
ActiveCell.Value = "=VLOOKUP(C15,A3:D7,4,FALSE)"
End Sub
Sub SCenario14()
ActiveCell.Value = WorksheetFunction.VLookup(ActiveCell.Offset(0, -1),
Range("A3:D7"), 4, False)
End Sub
###################################################
Sub Scenario1()
Dim i As Double
For i = 1 To 10
Workbooks.Add
Next
End Sub
Sub Scenario2()
Dim ProceedStatus As String
ProceedStatus = InputBox("Do you want to create a new workbook ? yes / no")
Sub Scenario4()
MsgBox Workbooks.Count
End Sub
Sub Scenario5()
Workbooks.Open ReadOnly:=True, Password:="123", Filename:="C:\00\Sample.xlsx"
End Sub
Sub Scenario6()
Workbooks("Sample.xlsx").Activate
End Sub
Sub Scenario7()
ThisWorkbook.Activate
End Sub
Sub Scenario8()
Dim i As Double
For i = 1 To Workbooks.Count
Workbooks(i).Activate
MsgBox "Activated"
Next
End Sub
Sub Scenario9()
Workbooks("Sample.xlsx").Close
End Sub
Sub Scenario10()
ActiveWorkbook.Close
End Sub
Sub Scenario11()
ThisWorkbook.Close
End Sub
Sub Scenario12()
MsgBox ActiveWorkbook.Name
End Sub
Sub Scenario13()
MsgBox ThisWorkbook.Name
End Sub
Sub Scenario14()
Dim i As Double
For i = 1 To Workbooks.Count
Workbooks(i).Activate
MsgBox Workbooks(i).Name
MsgBox Workbooks(i).Path
MsgBox Workbooks(i).FullName
Next
End Sub
Sub Scenario15()
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Sample2.xlsx"
End Sub
Sub Scenario16()
Dim i As Double
For i = 1 To 10
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\EG" & i & ".xlsx"
ActiveWorkbook.Close
Next
End Sub
Sub Scenario17()
Worksheets.Add
End Sub
Sub Scenario18()
Worksheets.Add After:=ActiveSheet
End Sub
Sub Scenario19()
Worksheets.Add before:=Worksheets(1)
End Sub
Sub Scenario20()
Worksheets.Add After:=Worksheets("Sample")
End Sub
Sub Scenario21()
MsgBox Worksheets.Count
End Sub
Sub Scenario22()
Worksheets.Add After:=Worksheets(Worksheets.Count)
End Sub
Sub Scenario23()
Worksheets(1).Select
End Sub
Sub Scenario24()
Worksheets("Sample").Select
End Sub
Sub Scenario25()
Worksheets(Worksheets.Count).Select
End Sub
Sub Scenario26()
Dim i As Double
For i = 1 To Worksheets.Count
Worksheets(i).Select
MsgBox "Selected"
Next
End Sub
Sub Scenario27()
MsgBox ActiveSheet.Name
End Sub
Sub Scenario28()
Dim i As Double
For i = 1 To Worksheets.Count
Worksheets(i).Select
MsgBox Worksheets(i).Name
Next
End Sub
Sub Scenario29()
ActiveSheet.Name = "Sample10"
End Sub
Sub Scenario30()
Dim i As Double
For i = 1 To Worksheets.Count
Worksheets(i).Name = "EG" & i
Next
End Sub
Sub Scenario31()
ActiveSheet.Visible = False
End Sub
Sub Scenario32()
Worksheets("EG4").Visible = False
End Sub
Sub Scenario33()
Dim i As Double
For i = 1 To Worksheets.Count
Worksheets(i).Visible = True
Next
End Sub
Sub Scenario34()
Application.DisplayAlerts = False
ActiveSheet.Delete
End Sub
Sub Scenario35()
Application.DisplayAlerts = False
Worksheets("EG5").Delete
End Sub
Sub Scenario36()
Worksheets("EG3").Copy
End Sub
Sub Scenario37()
Worksheets("EG3").Copy After:=Worksheets(Worksheets.Count)
End Sub
Sub Scenario38()
ActiveSheet.Move
End Sub
Sub Scenario39()
Worksheets(Worksheets.Count).Move before:=Worksheets(1)
End Sub
Sub Scenario40()
ActiveCell.Value = "Excelgoodies"
End Sub
Sub Scenario41()
Range("B15:D20").Value = "Excelgoodies"
End Sub
Sub Scenario42()
Selection.Value = "Excelgoodies"
End Sub
Sub Scenario43()
ActiveCell.EntireRow.Value = "Excelgoodies"
End Sub
Sub Sceanrio44()
Selection.ClearContents
End Sub
Sub Scenario45()
Selection.ClearFormats
End Sub
Sub Scenario46()
Selection.Clear
End Sub
Sub Scenario47()
ActiveCell.Offset(2, 0).Select
End Sub
Sub Scenario48()
ActiveCell.Offset(0, 2).Select
End Sub
Sub Scenario49()
ActiveCell.Offset(-2, 0).Select
End Sub
Sub Scenario50()
ActiveCell.Offset(0, -2).Select
End Sub
Sub Scenario51()
ActiveCell.End(xlDown).Select
End Sub
Sub Scenario52()
ActiveCell.End(xlToRight).Select
End Sub
Sub Scenario53()
ActiveCell.End(xlUp).Select
End Sub
Sub Scenario54()
ActiveCell.End(xlToLeft).Select
End Sub
Sub Scenario55()
ActiveCell.Offset(0, -1).Select
ActiveCell.End(xlDown).Select
ActiveCell.Offset(0, 1).Select
ActiveCell.End(xlUp).Select
End Sub
Sub Scenario56()
ActiveCell.Offset(0, -1).End(xlDown).Offset(0, 1).End(xlUp).Select
End Sub
Sub Scenario57()
ActiveCell.Offset(100000, 0).Select
ActiveCell.End(xlUp).Select
End Sub
Sub Scenario58()
ActiveCell.Offset(100000, 0).End(xlUp).Select
End Sub
Sub Scenario59()
Range("B5:D10").Select
End Sub
Sub Scenario60()
Range("B5", "D10").Select
End Sub
Sub Scenario61()
Range(ActiveCell, ActiveCell.Offset(2, 0)).Select
End Sub
Sub Scenario62()
Range(ActiveCell, ActiveCell.Offset(0, 2)).Select
End Sub
Sub Scenario63()
Range(ActiveCell, ActiveCell.End(xlDown)).Select
End Sub
Sub Scenario64()
Range(ActiveCell, ActiveCell.End(xlToRight)).Select
End Sub
Sub Scenario65()
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
End Sub
Sub Scenario66()
Range("B:D").Select
End Sub
Sub Scenario67()
Columns(2).Select
End Sub
Sub Scenario68()
Range(Columns(2), Columns(5)).Select
End Sub
Sub Scenario69()
Selection.EntireColumn.Select
End Sub
Sub Scenario70()
Range("2:5").Select
End Sub
Sub Scenario71()
Rows(2).Select
End Sub
Sub Scenario72()
Range(Rows(2), Rows(5)).Select
End Sub
Sub Scenario73()
Selection.EntireRow.Select
End Sub
Sub Scenario74()
Cells.Select
End Sub
Sub Scenario75()
Selection.SpecialCells(xlCellTypeBlanks).Select
End Sub
Sub Scenario76()
Selection.SpecialCells(xlCellTypeFormulas).Select
End Sub
Sub Scenario77()
Selection.SpecialCells(xlCellTypeConstants).Select
End Sub
Sub Scenario78()
Selection.Copy
Range("G13").PasteSpecial Paste:=xlPasteValues
Range("G13").PasteSpecial Paste:=xlPasteFormats
Range("G13").PasteSpecial Paste:=xlPasteColumnWidths
Application.CutCopyMode = False
End Sub
Sub Scenario79()
Range("D12").Copy
Range("D14:D18").PasteSpecial Paste:=xlPasteValues,
Operation:=xlPasteSpecialOperationAdd
Application.CutCopyMode = False
End Sub
Sub Scenario80()
Selection.Copy
Range("B20").PasteSpecial Paste:=xlPasteAll, Transpose:=True
Application.CutCopyMode = False
End Sub
Sub Scenario81()
Selection.Cut
Range("B24").Select
ActiveSheet.Paste
End Sub
Sub Scenario82()
Selection.EntireRow.Select
Selection.Copy
Selection.EntireRow.Insert
Application.CutCopyMode = False
End Sub
############################################################
Function EGCalculateSalesAmount(Rate As Double, Qty As Double) As Double
EGCalculateSalesAmount = Rate * Qty
End Function
End Function
End Function
End Function
End Function
End Function
EGCheckLoanStatus5 = "Eligible"
Else
EGCheckLoanStatus5 = "Not Eligible"
End If
End Function
########################################################
Function EGCalculateEBBill(ConsumerType As String, UnitsConsumed As Double) As
Double
Select Case LCase(ConsumerType)
Case "domestic"
Select Case UnitsConsumed
Case Is < 100
EGCalculateEBBill = UnitsConsumed * 1 + 20
Case 100 To 200
EGCalculateEBBill = UnitsConsumed * 1.5 + 20
Case 200 To 500
EGCalculateEBBill = UnitsConsumed * 3 + 30
Case Is > 500
EGCalculateEBBill = UnitsConsumed * 5.75 + 40
End Select
Case "commercial"
If UnitsConsumed < 100 Then
EGCalculateEBBill = UnitsConsumed * 4.3 + 100
Else
EGCalculateEBBill = UnitsConsumed * 7 + 100
End If
Case "cottage"
If UnitsConsumed < 500 Then
EGCalculateEBBill = 0
Else
EGCalculateEBBill = UnitsConsumed * 4
End If
Case Else
EGCalculateEBBill = UnitsConsumed * 5.5
End Select
End Function
Dim i As Double
For i = 1 To 10
MsgBox i
MsgBox EmployeeName
Next
End Sub
Sub Scenario2()
EmployeeName = InputBox("Enter Employee Name")
Dim i As Double
For i = 10 To 20
MsgBox i
MsgBox EmployeeName
Next
End Sub
Sub Scenario3()
EmployeeName = InputBox("Enter Employee Name")
Dim i As Double
For i = 1 To 10 Step 2
MsgBox i
MsgBox EmployeeName
Next
End Sub
Sub Scenario4()
EmployeeName = InputBox("Enter Employee Name")
Dim i As Double
For i = 10 To 1 Step -1
MsgBox i
MsgBox EmployeeName
Next
End Sub
Sub Scenario5()
EmployeeName = InputBox("Enter Employee Name")
End Sub
########################################################
Sub StaticProgrammingApproch()
Worksheets("Summary").Select
Range("C3:C8").Select
Selection.ClearContents
Range("C3").Select
Worksheets("Jan").Select
Range("C8").Select
Selection.Copy
Worksheets("Summary").Select
Range("C3").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Worksheets("Feb").Select
Range("C8").Select
Selection.Copy
Worksheets("Summary").Select
Range("C4").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub
Sub DynamicProgrammingApproch()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Worksheets("Summary").Select
Range("C3:C8").Select
Selection.ClearContents
Range("C3").Select
Dim i As Double
For i = 2 To Worksheets.Count
Worksheets(i).Select
Range("C8").Select
Selection.Copy
Worksheets("Summary").Select
ActiveCell.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
ActiveCell.Offset(1, 0).Select
Next
End Sub
##########################################
Sub Static_Programming()
Worksheets("Summary").Select
Range("C3:C8").ClearContents
Range("C3").Select
Worksheets("Jan").Select
Range("C8").Copy
Worksheets("Summary").Select
Range("C3").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Worksheets("Feb").Select
Range("C8").Copy
Worksheets("Summary").Select
Range("C4").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Worksheets("Mar").Select
Range("C8").Copy
Worksheets("Summary").Select
Range("C5").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub
Sub Dynamic_Programming()
Worksheets("Summary").Select
Range("C3:C8").ClearContents
Range("C3").Select
Dim i As Integer
For i = 2 To Worksheets.Count
Worksheets(i).Select
Range("C8").Copy
Worksheets("Summary").Select
ActiveCell.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
ActiveCell.Offset(1, 0).Select
Next
End Sub
##########################################
Sub Static_Programming()
Worksheets("Summary").Select
Range("C3:H7").ClearContents
Range("C3").Select
Worksheets("Jan").Select
Range("C3:C7").Copy
Worksheets("Summary").Select
Range("C3").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Worksheets("Feb").Select
Range("C3:C7").Copy
Worksheets("Summary").Select
Range("D3").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub
Sub Dynamic_Programming()
Worksheets("Summary").Select
Range("C3:H7").ClearContents
Range("C3").Select
Dim i As Integer
For i = 2 To Worksheets.Count
Worksheets(i).Select
Range("C3:C7").Copy
Worksheets("Summary").Select
ActiveCell.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
ActiveCell.Offset(0, 1).Select
Next
End Sub
###################################################
Sub Dynamic_Programming()
Worksheets("Summary").Select
Range("C3:C8").ClearContents
Range("C3").Select
Dim i As Integer
For i = 2 To Worksheets.Count
Worksheets(i).Select
Range("C100000").End(xlUp).Copy
Worksheets("Summary").Select
ActiveCell.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
ActiveCell.Offset(1, 0).Select
Next
End Sub
#######################################################
Sub Dynamic_Programming()
Worksheets("Summary").Select
Range("C3:C8").ClearContents
Range("C3").Select
Dim i As Integer
For i = 2 To Worksheets.Count
Worksheets(i).Select
Cells.Find(What:="Total").Offset(0, 1).Copy
Worksheets("Summary").Select
ActiveCell.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
ActiveCell.Offset(1, 0).Select
Next
End Sub
######################################################
Sub Dynamic_Programming()
Worksheets("Summary").Select
Range("C3:C8").ClearContents
Range("C3").Select
Dim i As Integer
For i = 2 To Worksheets.Count
Worksheets(i).Select
If WorksheetFunction.CountIf(Cells, "Total") > 0 Then
Cells.Find(What:="Total").Offset(0, 1).Copy
Worksheets("Summary").Select
ActiveCell.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
ActiveCell.Offset(1, 0).Select
Else
Worksheets("Summary").Select
ActiveCell.Offset(1, 0).Select
End If
Next
End Sub
#######################################################
Sub Dynamic_Programming()
Worksheets("Summary").Select
Range("C3:C8").ClearContents
Range("C3").Select
For i = 1 To Worksheets.Count
If LCase(Sheetname) = LCase(Worksheets(i).Name) Then
EGCheckSheetisAvailable = True
Exit Function
End If
Next
EGCheckSheetisAvailable = False
End Function
#############################################################
Sub GenerateSimpleXLReport()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
End Sub
#########################################################################
Sub GenerateDetailedXLReport()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Range("A1").PasteSpecial
Application.CutCopyMode = False
'ActiveSheet.Name = EmployeeName
Worksheets("Report").Select
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & EmployeeName & "-
Detailed.xlsx"
ActiveWorkbook.Close
Workbooks(DataSourceFileName).Activate
Selection.AutoFilter
ThisWorkbook.Activate
ActiveCell.Offset(1, 0).Select
Loop
Workbooks(DataSourceFileName).Close
MsgBox "Macro Complete"
End Sub
#########################################################################
Sub EGPrepareWorksheetForUse()
Cells.Select
Cells.RowHeight = 20
Cells.VerticalAlignment = xlCenter
Cells.EntireColumn.AutoFit
End Sub
Sub EGAddBorders(InputTopBorder As Boolean, InputRightBorder As Boolean,
InputBottomBorder As Boolean, _
InputLeftBorder As Boolean, InputVerticalBorder As Boolean,
InputHorizontalBorder As Boolean)
Call EGMakeSimpleSelection("A1")
Call EGPrepareWorksheetForUse
ActiveSheet.Name = EmployeeName
Worksheets("Data").Select
Selection.AutoFilter
Worksheets("Report").Select
ActiveCell.Offset(1, 0).Select
Loop
Call EGPrepareWorksheetForUse
Call EGMakeSimpleSelection("B3")
Call EGAddBorders(True, True, True, True, False, False)
End Sub
###########################################################
Sub EGMakeSimpleSelection(StartRange As String)
Range(StartRange).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
End Sub