Furman



Adder 3Sub AdderThree()a = Val(InputBox("Please enter the first value to be added"))MsgBox "This program is designed to add two numbers"b = Val(InputBox("Please enter the second value to be added"))c = a + bguess = Val(InputBox("Please enter your guess of the total"))If guess = c Then MsgBox "Good Guess!"Else MsgBox "You're wrong!"End IfRange("B10").SelectActiveCell.Value = cMsgBox "the total = " & cEnd SubVariables-conditions-loops1.xlsmSub captureSales() 'when you run this macro, it will take the sales of all the 12 stores we own 'it will ask for a reason if the sales are too low or too high Dim storeSales As Long Dim storeNum As Integer Dim reason As String Dim store As Range storeNum = 1 For Each store In Range("C7:C18") store.Value = InputBox("Sales for Store " & storeNum) If store.Value < 500 Or store.Value > 5000 Then reason = InputBox("Why are the sales deviated?", "Reason for Deviation", "Reason for Deviation") store.Offset(, 1).Value = reason End If storeNum = storeNum + 1 Next storeEnd SubCount HighFortySub CountCells2()Dim total As Integer, i As Integertotal = 0For i = 1 To 4 'ignore the two code lines below, they are only added to illustrate the loop Cells(i, 1).Select MsgBox "i = " & i If Cells(i, 1).Value > 40 Then total = total + 1Next iMsgBox total & " values higher than 40"End SubWorkSheetFunctions.xlsmOption ExplicitSub InsertSheet() ' Adds a new worksheet, and prompts user to name it. Dim objWS As Worksheet, strName As StringAgain: strName = InputBox("Sheet name?") ' Check to make sure the name is unique. If strName <> "" Then For Each objWS In Worksheets If LCase(objWS.Name) = LCase(strName) Then GoTo Again Next objWS End If ' Add new worksheet after the active sheet. Set objWS = Worksheets.Add(After:=ActiveSheet) ' If user provided a name, assign that name. If strName <> "" Then objWS.Name = strNameEnd SubSub NewRecord() ' Add new record and increment the value in the first column. Sheets("Employees").Activate ' Select the first cell after the last filled cell in column A. Range("A1").End(xlDown).Offset(1, 0).Select ' Determine the maximum value in the column and add 1. ActiveCell = WorksheetFunction.Max(ActiveCell.EntireColumn) + 1End SubSub Summary() ' Displays the sum, average, and count of the selected range. Dim objSelect As Range Dim iCount As Long, pSum As Double, pAvg As Double Sheets("Employees").Activate ' Prompt user for range to summarize. Set objSelect = Application.InputBox(Prompt:="Select range of values to summarize", _ Default:=Selection.Address, _ Type:=8) objSelect.Select ' Use Count, Sum, and Average worksheet functions ' on the selected range. iCount = WorksheetFunction.Count(objSelect) pSum = WorksheetFunction.Sum(objSelect) pAvg = WorksheetFunction.Average(objSelect) ' Display values. MsgBox "Count: " & iCount & vbCr & _ "Sum: " & FormatNumber(pSum, 2) & vbCr & _ "Avg: " & FormatNumber(pAvg, 2)End SubSub PMT_Table() ' Creates a table of mortgage payments for specified loan amount and APR. Dim i As Integer, j As Integer, curAmount As Currency, fAPR As Single Dim objCell As Range, curPMT As Currency ' Call InsertSheet Sub procedure. InsertSheet ' Prompt user for loan amount and APR. curAmount = InputBox(Prompt:="Loan amount?", _ Default:=60000) fAPR = InputBox(Prompt:="APR?", _ Default:=0.06) ' Create APR column headings, and loan amount row labels. For i = 0 To 9 For j = 0 To 9 Cells(1, j + 2) = FormatPercent(fAPR + 0.0005 * j) Next j Cells(i + 2, 1) = FormatCurrency(curAmount + (curAmount / 100) * i) Next i ' Fill in payment table values. For i = 2 To 11 For j = 2 To 11 curPMT = WorksheetFunction.Pmt(Arg1:=Cells(1, j) / 12, Arg2:=360, Arg3:=Cells(i, 1)) Cells(i, j) = FormatCurrency(curPMT) Next j Next i ' Format cells as bold, and autofit columns. Cells.Font.Bold = True Cells.EntireColumn.AutoFitEnd SubSub CalcSalaries() ' Calculates the sum of saleries for the specified department and location. Dim objDept As Range, objLoc As Range, objSal As Range Dim strDept As String, strLoc As String, curSum As Currency Sheets("Employees").Activate ' This With statement returns a Range object that represents the range ' that surrounds the active cell. With ActiveCell.CurrentRegion ' Set ranges for the department, location, and salary columns. Set objDept = .Columns(4) Set objLoc = .Columns(5) Set objSal = .Columns(6) ' Prompt for department and location. strDept = InputBox(Prompt:="Which department (cancel or blank for all departments)?", _ Default:="Finance") If strDept = "" Then strDept = "*" strLoc = InputBox(Prompt:="Which location (cancel or blank for all locations)?", _ Default:="Boston") If strLoc = "" Then strLoc = "*" ' Calculate and display sum of specified salaries. curSum = WorksheetFunction.SumIfs(objSal, objDept, strDept, objLoc, strLoc) MsgBox "The total for " & strDept & " in " & strLoc & " is: " & FormatCurrency(curSum) End WithEnd SubSub CleanUpData() ' Trims irregular spacing, and corrects capitalization. Dim objCell As Range For Each objCell In ActiveCell.CurrentRegion objCell = WorksheetFunction.Trim(oCell) objCell = WorksheetFunction.Proper(oCell) Next objCellEnd Sub ................
................

In order to avoid copyright disputes, this page is only a partial summary.

Google Online Preview   Download