Loops and Report Writing Basics

Intro to Loops; the For Next Loop
    Sub myFirstLoop()
        For x = 1 To 10
            Cells(x, 1) = x
        Next x
    End Sub
    
Top

Index

Fun with our For Next Loop
    Sub myFirstLoop()
        For x = 1 To 10
            Cells(x, 1) = x * 12.75
            If Cells(x, 1) > 50 Then
                Cells(x, 2) = True
                Cells(x, 2).Font.Bold = True
            Else
                Cells(x, 2) = False
                Cells(x, 2).Font.Bold = False
            End If
        Next x
    End Sub
    
Top

Index

Beginning our first Report using Loops
    Sub myFirstReport()
        lastRow = Cells(Rows.Count, 1).End(xlUp).Row
        For x = 2 To lastRow
            If Cells(x, 4) >= 200 Then
                myMsg = myMsg & vbNewLine & Cells(x, 1)
            End If
        Next x
        MsgBox myMsg
    End Sub
    
Top

Index

Using an InputBox
    Sub myInputBox()
        inputData = InputBox(<prompt>, <title>, <default value>)
    End Sub
    
Top

Index

Adding InputBox to Our First Report to make it Dynamic
    Sub myFirstReport()
        lastRow = Cells(Rows.Count, 1).End(xlUp).Row
        inputData = InputBox("How much money should they make?", "Input?", "200")
        ' convert to double, can throw an exception
        inputData = CDbl(inputData)

        For x = 2 To lastRow
            If Cells(x, 4) >= inputData Then
                myMsg = myMsg & vbNewLine & Cells(x, 1) & ", " & Cells(x, 2)
            End If
        Next x
        MsgBox myMsg
    End Sub
    
Top

Index

Adding a Button to Open Our Report
in design mode add an ActiveX button to worksheet
double click the button and an event handler is added
in the event handler call the macro shown above
    Private Sub CommandButton1_Click()
        Call myFirstReport
    End Sub
    
out of design mode clicking the button will call the macro
Top

Index

Add a Cool Looking Button or Image to Open Report
delete the button added in the last lecture
from Insert tab add a rounded rectangle shape
add a caption
center caption using alignment tools on Home tab
right click on shape and assign the macro
Top

Index

Our First Printable Report Part 1 - Declaring and Setting the Sheets
add a new worksheet and rename myRpt
add clolumn headers Name and Sales Amount
rename Sheet 1 data
rename macro myPrintableReport
change event macro of button to macro's new name declare variables for worksheets and make assignments to variables
add a variable to track rows in myRpt
Top

Index

Printable Report Part 2 - Getting Items on Report Sheet
    Sub myPrintableReport()
        Dim dataSheet As Worksheet
        Dim reportSheet As Worksheet
        Set dataSheet = ThisWorkbook.Sheets("data")
        Set reportSheet = ThisWorkbook.Sheets("myRpt")
        ' get last row from dataSheet
        lastRow = dataSheet.Cells(Rows.Count, 1).End(xlUp).Row
        inputData = InputBox("How much money should they make?", "Input?", "200")
        inputData = CDbl(inputData)
        y = 2 'starting row on myRpt worksheet

        For x = 2 To lastRow
            If dataSheet.Cells(x, 4) >= inputData Then
                reportSheet.Cells(y, 1) = dataSheet.Cells(x, 1) ' name
                reportSheet.Cells(y, 2) = dataSheet.Cells(x, 4) ' sales amount
                y = y + 1
            End If
        Next x
    End Sub
    
add a second shape to the data worksheet with the caption Printable Report
assign macro to new shape
Top

Index

Printable Report Part 3 - Clearing Last Report
    Sub myPrintableReport()
        Dim dataSheet As Worksheet
        Dim reportSheet As Worksheet
        Set dataSheet = ThisWorkbook.Sheets("data")
        Set reportSheet = ThisWorkbook.Sheets("myRpt")

        dataSheetLastRow = dataSheet.Cells(Rows.Count, 1).End(xlUp).Row
        ' clear report worksheet
        reportSheetLastRow = reportSheet.Cells(Rows.Count, 1).End(xlUp).Row
        reportSheet.Range("A2:B" & reportSheetLastRow).ClearContents

        inputData = InputBox("How much money should they make?", "Input?", "200")
        inputData = CDbl(inputData)
        y = 2 'starting row on myRpt worksheet

        For x = 2 To dataSheetLastRow
            If dataSheet.Cells(x, 4) >= inputData Then
                reportSheet.Cells(y, 1) = dataSheet.Cells(x, 1) ' name
                reportSheet.Cells(y, 2) = dataSheet.Cells(x, 4) ' sales amount
                y = y + 1
            End If
        Next x
    End Sub
    
Top

Index

Printable Report Part 4 - Ensuring Visibility and Autoselect Report Sheet
    Sub myPrintableReport()
        Dim dataSheet As Worksheet
        Dim reportSheet As Worksheet
        Set dataSheet = ThisWorkbook.Sheets("data")
        Set reportSheet = ThisWorkbook.Sheets("myRpt")

        dataSheetLastRow = dataSheet.Cells(Rows.Count, 1).End(xlUp).Row
        ' clear report worksheet but keep header row
        reportSheetLastRow = reportSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
        reportSheet.Range("A2:B" & reportSheetLastRow).ClearContents

        inputData = InputBox("How much money should they make?", "Input?", "200")
        inputData = CDbl(inputData)
        y = 2 'starting row on myRpt worksheet

        For x = 2 To dataSheetLastRow
            If dataSheet.Cells(x, 4) >= inputData Then
                reportSheet.Cells(y, 1) = dataSheet.Cells(x, 1) ' name
                reportSheet.Cells(y, 2) = dataSheet.Cells(x, 4) ' sales amount
                y = y + 1
            End If
        Next x
        ' make report visible
        reportSheet.Visible = True
        ' bring sheet to foreground
        reportSheet.Select
    End Sub
    
Top

Index

Using PrintPreview Automatically
    Sub myPrintableReport()
        Dim dataSheet As Worksheet
        Dim reportSheet As Worksheet
        Set dataSheet = ThisWorkbook.Sheets("data")
        Set reportSheet = ThisWorkbook.Sheets("myRpt")

        dataSheetLastRow = dataSheet.Cells(Rows.Count, 1).End(xlUp).Row
        ' clear report worksheet
        reportSheetLastRow = reportSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
        reportSheet.Range("A2:C" & reportSheetLastRow).ClearContents

        ' should the report be titled?
        includeTitle = MsgBox("Add title to report?", vbYesNo)
        If includeTitle = vbYes Then
            reportSheet.Cells(1, 3) = "Title"
        Else
            reportSheet.Cells(1, 3) = ""
        End If

        ' query for amount
        inputData = InputBox("How much money should they make?", "Input?", "200")
        inputData = CDbl(inputData)

        y = 2 'starting row on myRpt worksheet

        For x = 2 To dataSheetLastRow
            If dataSheet.Cells(x, 4) >= inputData Then
                reportSheet.Cells(y, 1) = dataSheet.Cells(x, 1) ' name
                reportSheet.Cells(y, 2) = dataSheet.Cells(x, 4) ' sales amount
                If includeTitle = vbYes Then
                    reportSheet.Cells(y, 3) = dataSheet.Cells(x, 2) ' title
                End If
                y = y + 1
            End If
        Next x
        ' make report visible
        reportSheet.Visible = True
        ' bring sheet to foreground
        reportSheet.Select
        ' show print preview
        reportSheet.PrintPreview

    End Sub
    
Top

Index

Using PrintOut to Send Directly to the Default Printer
replace reportSheet.PrintPreview with
    reportSheet.PrintOut Copies:=1
    
Top

Index

Handling Debug Error When Cancelling InputBox
macro now contains a wy to handle potential errors from cancel button on Input box
also will exit the sub if no value found
    Sub myPrintableReport()
        Dim dataSheet As Worksheet
        Dim reportSheet As Worksheet
        Set dataSheet = ThisWorkbook.Sheets("data")
        Set reportSheet = ThisWorkbook.Sheets("myRpt")

        dataSheetLastRow = dataSheet.Cells(Rows.Count, 1).End(xlUp).Row
        ' clear report worksheet
        reportSheetLastRow = reportSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
        reportSheet.Range("A2:C" & reportSheetLastRow).ClearContents

        ' should the report be titled?
        includeTitle = MsgBox("Add title to report?", vbYesNo)
        If includeTitle = vbYes Then
            reportSheet.Cells(1, 3) = "Title"
        Else
            reportSheet.Cells(1, 3) = ""
        End If

        On Error Resume Next
        ' query for amount
        inputData = InputBox("How much money should they make?", "Input?", "200")

        ' exit if no value
        If inputData = Empty Then Exit Sub

        inputData = CDbl(inputData)

        y = 2 'starting row on myRpt worksheet

        For x = 2 To dataSheetLastRow
            If dataSheet.Cells(x, 4) >= inputData Then
                reportSheet.Cells(y, 1) = dataSheet.Cells(x, 1) ' name
                reportSheet.Cells(y, 2) = dataSheet.Cells(x, 4) ' sales amount
                If includeTitle = vbYes Then
                    reportSheet.Cells(y, 3) = dataSheet.Cells(x, 2) ' title
                End If
                y = y + 1
            End If
        Next x
        ' make report visible
        reportSheet.Visible = True
        ' bring sheet to foreground
        reportSheet.Select
        ' show print preview
        reportSheet.PrintPreview

    End Sub
    
Top

Index

For Loop Going Backwards using STEP
    Sub nextLoop
        For x = 20 To 2 Step -1
            MsgBox x
        Next x
    End Sub
    
Top

Index

The For Each Loop
    Sub foreachLoop1()
        For Each sheet in Range("Name")
            If cell = "Kelly" Then Exit For
            MsgBox cell
        Next cell
    End Sub
    
    Sub foreachLoop2()
        For Each sheet in ActiveWorkbook.Sheets
            MsgBox sheet.Name
        Next sheet
    End Sub
    
Top

Index

For Each Loop - Practical Examples
    
Top

Index

Do Until
    Sub doLoop()
        x = 2
        Do Until Cells(x, 1) = ""
            MsgBox Cells(x, 1)
            x = x = 1
        Loop
    End Sub
        
Top

Index

Loop Until
    Sub doLoop()
        x = 2
        Do
            MsgBox Cells(x, 1)
            x = x = 1
        Loop Until Cells(x, 1) = ""
    End Sub
    
Top

Index

Do While
    Sub doLoop()
        x = 2
        Do While Cells(x, 1) <> ""
            MsgBox Cells(x, 1)
            x = x = 1
        Loop
    End Sub
    
Top

Index

Loop While
    Sub doLoop()
        x = 2
        Do
            MsgBox Cells(x, 1)
            x = x = 1
        Loop While Cells(x, 1) <> ""
    End Sub
    
Top

Index

Exit Do - Multiple Exits using your own Criteria along the Way
    Sub doLoop()
        x = 2
        Do
            If Cells(x, 1) = "" Then Exit Do
            MsgBox Cells(x, 1)
            x = x = 1
        Loop
    End Sub
    
Top

Index

Loop Through Multiple Files in a Folder and Scrape Data From Each
    Sub getDataFromWbs()

    Dim wb As Workbook, ws As Worksheet
    Set fso = CreateObject("Scripting.FileSystemObject")

        'This is where you put YOUR folder name
        Set fldr = fso.GetFolder("<directory path>")

        'Next available Row on Master Workbook
        y = ThisWorkbook.Sheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row + 1

        'Loop through each file in that folder
        For Each wbFile In fldr.Files

        'Make sure looping only through files ending in .xlsx (Excel files)
        If fso.GetExtensionName(wbFile.Name) = "xlsx" Then

            'Open current book
            Set wb = Workbooks.Open(wbFile.Path)

            'Loop through each sheet (ws)
            For Each ws In wb.Sheets
                'Last row in that sheet (ws)
                wsLR = ws.Cells(Rows.Count, 1).End(xlUp).Row

                'Loop through each record (row 2 through last row)
                For x = 2 To wsLR
                    'Put column 1,2,3 and 4 of current sheet (ws) into row y of master sheet, then increase row y to next row
                    ThisWorkbook.Sheets("sheet1").Cells(y, 1) = ws.Cells(x, 1) 'col 1
                    ThisWorkbook.Sheets("sheet1").Cells(y, 2) = ws.Cells(x, 2) 'col 1
                    ThisWorkbook.Sheets("sheet1").Cells(y, 3) = CDate(ws.Cells(x, 3)) 'col 1
                    ThisWorkbook.Sheets("sheet1").Cells(y, 4) = ws.Cells(x, 4) 'col 1
                    y = y + 1
                Next x
            Next ws

            'Close current book
            wb.Close
        End If

        Next wbFile
    End Sub
    
Top

Index

Exercise 7a
    Sub exercise7a()
        Dim dataSheet As Worksheet
        Dim reportSheet As Worksheet
        Set dataSheet = ThisWorkbook.Sheets("data")
        Set reportSheet = ThisWorkbook.Sheets("myRpt")

        dataSheetLastRow = dataSheet.Cells(Rows.Count, 1).End(xlUp).Row
        ' clear report worksheet
        reportSheetLastRow = reportSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
        reportSheet.Range("A2:C" & reportSheetLastRow).ClearContents

        ' should the report be titled?
        includeTitle = MsgBox("Add title to report?", vbYesNo)
        If includeTitle = vbYes Then
            reportSheet.Cells(1, 3) = "Title"
        Else
            reportSheet.Cells(1, 3) = ""
        End If

        ' query for name
        salesPosition = InputBox("Get sales for specific sales position", "Get sales for specific sales position")

        ' query for amount
        inputData = InputBox("How much money should they make?", "Input?", "200")
        inputData = CDbl(inputData)

        y = 2 'starting row on myRpt worksheet

        For x = 2 To dataSheetLastRow
            If dataSheet.Cells(x, 4) >= inputData And salesPosition <> "" And dataSheet.Cells(x, 2) = salesPosition Then
                reportSheet.Cells(y, 1) = dataSheet.Cells(x, 1) ' name
                reportSheet.Cells(y, 2) = dataSheet.Cells(x, 4) ' sales amount
                If includeTitle = vbYes Then
                    reportSheet.Cells(y, 3) = dataSheet.Cells(x, 2) ' title
                End If
                y = y + 1
            ElseIf dataSheet.Cells(x, 4) >= inputData And salesPosition = "" Then
                reportSheet.Cells(y, 1) = dataSheet.Cells(x, 1) ' name
                reportSheet.Cells(y, 2) = dataSheet.Cells(x, 4) ' sales amount
                If includeTitle = vbYes Then
                    reportSheet.Cells(y, 3) = dataSheet.Cells(x, 2) ' title
                End If
                y = y + 1
            End If
        Next x
        ' make report visible
        reportSheet.Visible = True
        ' bring sheet to foreground
        reportSheet.Select
    End Sub
    
Top

Index

Exercise 7b
    Sub exercise7b()
        For n = 2 To 26
            Cells(n, "A") = n - 1
            Cells(n, "B") = "Person" & n - 1
            If n > 17 Then
                Cells(n, "A").Interior.Color = 255
            End If
        Next n
    End Sub
      
Top

Index

n4jvp.com