‘ Declare CustomerName to be a variable which holds text

Dim CustomerName as String

‘ Store the word Michael in the CustomerName variable

CustomerName = “Michael”

‘ Store the word Smith by appending it to whatever is currently stored in the CustomerName variable. In this case, the variable will contain Michael Smith. A space was included inside the quotation marks, so that the name would appear as 2 separate words.

CustomerName = CustomerName & “ Smith”

‘ Declare AccountBalance to be a variable that holds numbers

Dim AccountBalance as Long

‘ Store the number 10,000 in the AccountBalance variable

AccountBalance = 10000

AccountBalance = AccountBalance - 6000 ‘ Decrease the AccountBalance variable by 6000

‘ Declare BankChart as a variable that stores a spreadsheet’s filename

Dim BankChartsWB as Workbook

‘ Store the name of the spreadsheet file called Banking.xlsx as a variable.

Set BankChartsWB = Workbooks("Banking.xlsx")

' Close workbook without saving

BankChartsWB.Close SaveChanges:=False

' Save the spreadsheet that is active

ActiveWorkbook.Save

' Close the spreadsheet that is active

ActiveWorkbook.Close

Dim AccountTab as Worksheet

Set AccountTab = Workbooks ("Banking.xlsx").Worksheets("Account")

‘ Activate a spreadsheet file

Workbooks("Filename.xlsx").Activate

‘ Activate a spreadsheet file

WorkbookVariableName.Activate

‘ Activate a worksheet tab

Workbooks("Filename.xlsx").Worksheets( "TabName").Activate

‘ Activate a worksheet tab

WorksheetVariableName.Activate

‘ Unhides all hidden cells

ActiveSheet.ShowAllData

‘ Expands all grouped cells to the most expanded level (8th) level

ActiveSheet.ShowLevels RowLevels:=8, ColumnLevels:=8

' Insert a tab after the tab called TabName

Sheets.Add After:=Sheets(“TabName”)

' Insert a blank tab after the 3^rd tab in the spreadsheet

Sheets.Add After:=Sheets(3)

' Insert a blank tab after the last tab

Sheets.Add After:=Sheets(Sheets.Count)

' Duplicate the tab, and place the copy after the worksheet called TabName

ActiveSheet.Copy After:=Sheets(“TabName”)

' Duplicate the tab, and place the copy after the 2^nd tab

ActiveSheet.Copy After:=Sheets(2)

' Duplicate the tab, and place the copy after the last worksheet

ActiveSheet.Copy After:=Sheets(Sheets.Count)

‘ Renames the active tab to NewTabName

ActiveSheet.Name = "NewTabName"

Range("A1") or Range("A1:C3")

Cells(RowNumber,ColumnNumber)

Cells(5,10) is the equivalent of Range("J5")

Range(Cells(1stCellRow,1stCellColumn),Cells(2ndCellRow,2ndCellColumn))

Range(Cells(1,2),Cells(10,3)) is the equivalent of Range("B1:C10")

Range("A1")

Workbooks("Filename.xlsx").Worksheets("TabName").Range("A1")

TabVariableName.Range(“A1”)

ActiveCell

Activesheet.Range("A1").Select

Activesheet.Cells(2,3).Select

Range("D2:Y2").Select

’ Selects cells B1 to C10

Range(Cells(1,2),Cells(10,3)).Select

' Move the cursor one cell upwards

Selection.Offset(-1, 0).Select

' Move the cursor one cell downwards

Selection.Offset(1, 0).Select

' Move the cursor one cell to the left

Selection.Offset(0, -1).Select

' Move the cursor one cell to the right

Selection.Offset(0, 1).Select

‘ Saves the word Michael in cell A1

Range("A1").Value = “Michael”

‘Appends the word Smith to the text that is already in cell A1

Range("A1").Value = Range("A1").Value & “ Smith”

‘ Saves cell A1 into the FullName variable

FullName = Range("A1").Value

' Decrease a cell value by one.

Range("A1").Value = Range("A1").Value - 1

' Increase a cell value by one.

Range("A1").Value = Range("A1").Value + 1

‘Deletes all blank rows

Range("A1:Z99").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

‘Deletes all non-numeric rows

Range("A1:Z99").SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete

‘Deletes all rows that contain errors

Range("A1:Z99").SpecialCells(xlConstants, xlErrors).EntireRow.Delete

‘Remove duplicates from column 1 or A in the range of cells from A1 to A99, which is a range that does not include a header row

Range("A1:A99").RemoveDuplicates Columns:=1, Header:=xlNo

‘ Selects all of the cells from A1 to B10

Range(“A1:B10”).Select

‘Copies the selected cells to the clipboard. This is like pressing CTRL+C.

Selection.Copy

‘ Moves the cursor to the specific cell, which is cell C50

Range(“C50”).Select

‘Pastes the clipboard contents into the cell, like pressing CTRL+V.

Activesheet.Paste

‘Pastes Values

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

‘Pastes Formulas

Selection.PasteSpecial Paste: =xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

‘Paste Cell Formats

Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

' Remove clipboard cut/copy border (aka "ants")

Application.CutCopyMode = False

' Apply bold font to the selected cell(s)

Selection.Font.Bold = True

Selection.Style = "Comma" ' Display numbers with commas to indicate thousands, millions, etc as well as two decimal points

' Apply text wrap format to selected cell(s)

Selection.WrapText = True

‘Format numbers to show commas, show zeros as dashes, and have negatives in brackets

Selection.NumberFormat = "_(* #,##0_);_(* (#,##0);""-"";_(@_)"

' Change the colour of the text in the selected cell(s) to red

With Selection.Font

.Color = -16776961

.TintAndShade = 0

End With

‘ Change the cell alignment to bottom, unmerge cells, and wrap text

With Selection

.HorizontalAlignment = xlGeneral

.VerticalAlignment = xlBottom

.WrapText = True

.ShrinkToFit = False

.MergeCells = False

End With

' Apply orange fill to the cell selection

With Selection.Interior

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

.Color = 49407

.TintAndShade = 0

.PatternTintAndShade = 0

End With

CELL BORDERS

' Insert cell borders to the top of the cell selection

With Selection.Borders(xlEdgeTop)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

' Insert cell borders to the bottom of the cell selection

With Selection.Borders(xlEdgeBottom)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

' Remove all borders from selected cells

Selection.Borders(xlDiagonalDown).LineStyle = xlNone

Selection.Borders(xlDiagonalUp).LineStyle = xlNone

Selection.Borders(xlEdgeLeft).LineStyle = xlNone

Selection.Borders(xlEdgeRight).LineStyle = xlNone

Selection.Borders(xlInsideVertical).LineStyle = xlNone

Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

' Expand all grouped columns & rows

ActiveSheet.Outline.ShowLevels RowLevels:=8, ColumnLevels:=8

' Collapse all grouped columns & rows

ActiveSheet.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1

' Place an autofilter on the cell selection, or remove it if there already is one

Selection.AutoFilter

' Filter this range of cells to only show rows with a "1" in the 9th column.

ActiveSheet.Range("A1:Z99").AutoFilter Field:=9, Criteria1:="1"

' From cell A1 to A99, select only the visible cells which are not filtered out.

ActiveSheet.Range(Cells(1, 1), Cells(99, 1)).SpecialCells(xlCellTypeVisible).Select

' If this row has been filtered to be invisible, then...

If Rows(1).EntireRow.Hidden Then

' Temporarily ignore errors, such as if there's no filter

On Error Resume Next

' Unfilter any filtered data

ActiveSheet.ShowAllData

' Resume the regular error procedure ie stop for any bugs in the code

On Error GoTo 0

EndIf

' Add cells A1 to A99

Cells(RowNumber, ColumnNumber).Formula = "=SUM(A1:A99)"

' Add the amounts from the cell that is in the same row and 5 columns to the left, to the cell that is 4 rows below and 2 columns to the left of the cell with this formula. Note: R[+0]C[-5] can be coded as RC[-5]

Cells(RowNumber, ColumnNumber).FormulaR1C1 = "=SUM(RC[-5]:R[+4]C[-2])"

' Hard return (aka new line) within a string of text in a cell

Chr(13) & Chr(10)

' Use the LEFT() function to obtain the leftmost character, which is the column letter, from the cell address and stores the letter in the underlined string variable

ColumnLetter = Left(SearchRange.Address (RowAbsolute:=false, Columnabsolute:=False), 1)

' Add the amounts from row 1 of the column that is defined by the variable to cell Z99

Cells(7, 4).Formula = "=SUM(" & ColumnLetter & "1:Z99)"

Dim RangeOfCells, RangeOfSum, Filename, DataTabname As String

Dim FirstRowOfData, LastRowOfData as Long

RangeOfCells = Chr(39) & "[" & FileName & "]" & DataTabName & Chr(39) & "!$A$" & FirstRowOfData & ":$A$" & LastRowOfData

RangeOfSum = Chr(39) & "[" & FileName & "]" & DataTabName & Chr(39) & "!$B$" & FirstRowOfData & ":$B$" & LastRowOfData

Range("D11").Value = RangeOfCells

Range("F11").Value = RangeOfSum

Range("G23").Value = "=sumif(indirect ($D$11),$B23,indirect($F$11))"

‘ Locate the first cell which contains the date that is indicated, and store the cell address in the range variable called SearchDate.

RowNumber = ActiveSheet.Columns (ColumnNumberToSearch).Find(What: ="TextToSearchFor", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

Dim SearchDate as Range

‘Find each text string on a worksheet and replaces it as indicated

Set SearchDate = Cells.Find(What:=CDate("2/01/2020"), After:=Range("A1"), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)

Cells.Replace What:="Old Text That Needs To Be Replaced", Replacement:="New Text That Needs To Replace The Old Text", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=True

‘ Places the cursor at cell A1 in order to prepare for the search

ActiveSheet.Range(“A1”).Select

‘ Searches through the specified column in a backwards direction from the current cursor position and provides the row number which contains the last row of text, then stores this row number in the numeric variable called LastRowWithData

LastRowWithData = ActiveSheet.Columns(ColumnNumberToSearchThrough).Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

‘ Searches through the specified row in a backwards direction from the current cursor position and provides the column number which contains the last column of text, then stores this column number in the numeric variable called LastColumnWithData

LastColumnWithData = ActiveSheet.Rows(RowNumberToSearchThrough). Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

‘Determines the last row with data and stores it in the variable

LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

‘Determines the last row with data and stores it in the variable

LastColumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column

If Variable1 = “Joe” And Variable2 = “Smith” And Variable3 = “New York” Then

End If

If Variable1 = “Joe” Or Variable1 = “John” Or Variable1 = “Michael” Then

End If

If Variable1 = “Joe” Then

ElseIf Variable1 = “John” Then

Else:

End If

Dim SearchRange as Range

Dim SearchSubString as Text

Dim ColumnToCopy as Long

' Search cell values for the string of text

Set SearchRange = Cells.Find(What:=SearchSubString, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

‘ If the string of text is not found, then this variable will be equal to Nothing

If SearchRange Is Nothing Then

‘ Jump to line 10 in the code

GoTo 10

‘ If the above condition is not true (ie if the string of text is found)…

Else

‘ Save the column # with the text in the ColumnToCopy numeric variable

ColumnToCopy = SearchRange.Column

End If

Select Case ColumnHeading 'Check to see if the current column is on the list of columns to keep

Case "", "ColumnName1", " ColumnName2", " ColumnName3" ' For these column headings...

GoTo 110 ' Move the macro past the following code, by jumping to line 110

Case Else ' For any column headings that are not listed in the case above...

' Select the column that is determined by the ColumnCounterNumber variable

Columns(ColumnNumber).Select

Selection.Delete Shift:=xlToLeft ' Delete the selected column

End Select

110 ' This is the Go To location for the cases that are listed above. It allows the macro to skip the code in the Case Else section, which would have deleted the column.

On Error Resume Next ' Temporarily ignore errors, such as if there's no filter to begin with

On Error GoTo 0 ' Resume the regular error procedure, which is to stop for any bugs in the code.

Application.DisplayAlerts = False

Worksheets("Data").Delete

Application.DisplayAlerts = True

Dim counter As Integer ‘ Declare an integer variable called "counter" to run a loop

For counter = 0 To 10 ‘The looped code will run 11 times as the variable increases from 0 to 10.

Selection.Value = counter ‘ Inputs the value of the counter variable into the selected cell

Selection.Offset(1, 0).Select ‘ Move the cursor down one cell

Next counter ‘ Repeat the code after the “For counter” line until the variable has reached its maximum value

For Each Cell In ActiveSheet.Range("A1","A99")

If Cell.Value = 0 Then

Cell.EntireRow.Delete

EndIf

Next

Dim cell, joinedCells As Range

For Each cell In ThisWorkbook.ActiveSheet.Range("A1:B4")

If cell.MergeCells Then

Set joinedCells = cell.MergeArea

cell.MergeCells = False

joinedCells.Value = cell.Value

End If

Next

‘ Declare Variables

Sub InsertPivotTable()

Dim PivotWorksheet As Worksheet

Dim DataWorksheet As Worksheet

Dim PivotCache1 As PivotCache

Dim PivotTable1 As PivotTable

Dim PivotDataRange As Range

Dim LastRow As Long

Dim LastCol As Long

‘ Alternative 1: Insert the pivot table into an existing worksheet

Set PivotWorksheet = Worksheets("PivotTable")

Set DataWorksheet = Worksheets(“Data”)

Worksheets("PivotTable").Activate

On Error Resume Next

ActiveSheet.PivotTables("PivotTable1").TableRange2.Clear

‘Alternative 2: Insert the pivot table into a new blank worksheet

On Error Resume Next

Application.DisplayAlerts = False

Worksheets("PivotTable").Delete

Sheets.Add Before:=ActiveSheet

ActiveSheet.Name = "PivotTable"

Application.DisplayAlerts = True

Set PivotWorksheet = Worksheets("PivotTable")

Set DataWorksheet = Worksheets("Data")

‘ Define Data Range

LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

LastCol = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column

Set PivotDataRange = ActiveSheet.Cells(1, 1).Resize(LastRow, LastCol)

‘ Define Pivot Cache

Set PivotCache1 = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PivotDataRange).CreatePivotTable(TableDestination:=PivotWorksheet.Cells(2, 2), TableName:="PivotTable1")

‘ Insert Blank Pivot Table

Set PivotTable1 = PivotCache1.CreatePivotTable (TableDestination:=PivotWorksheet.Cells(1, 1), TableName:="PivotTable1")

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="Data!R2C1:R99C10", Version:=xlPivotTableVersion12).CreatePivotTable TableDestination:="PivotTableWorksheet!R3C1", TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion12 ‘ Create a pivot table on cell A3 of the "PivotTableWorksheet", which has its source data in the "Data" worksheet from A2:J99

'The Currency field is set up to appear as rows in the pivot table

‘ Insert Row Fields

With ActiveSheet.PivotTables("PivotTable1"). PivotFields("Year")

.Orientation = xlRowField

.Position = 1

End With

With ActiveSheet.PivotTables("PivotTable1"). PivotFields("Month")

.Orientation = xlRowField

.Position = 2

End With

' The Currency field is set up as a column

With ActiveSheet.PivotTables("PivotTable1"). PivotFields("Currency")

.Orientation = xlColumnField

.Position = 1

End With

‘ Insert Value aka Data Field

With ActiveSheet.PivotTables("PivotTable1")

.PivotFields ("Amount")

.Orientation = xlDataField

.Function = xlSum

.NumberFormat = "#,##0"

.Name = "Revenue "

End With

ActiveSheet.PivotTables("PivotTable1").AddDataField

' The AccountCode is set up as a count value field in the pivot table

ActiveSheet.PivotTables("PivotTable1").PivotFields("AccountCode "), "Count of AccountCode ", xlCount

' The Fee value field is changed to be a sum value in the pivot table

With ActiveSheet.PivotTables("PivotTable1"). PivotFields("Count of Fee")

.Caption = "Sum of Fee"

.Function = xlSum

End With

' Set up a formula within the pivot which subtracts January from February

ActiveSheet.PivotTables("PivotTable1").PivotFields("Month").CalculatedItems. Add "Formula1", "='February' -'January'", True

'The payment column is set up as a filter

With

ActiveSheet.PivotTables("PivotTable1").PivotFields("Payment")

.Orientation = xlPageField

.Position = 1

End With

' Filtered values are indicated for the Payment field

With

ActiveSheet.PivotTables("PivotTable1").PivotFields("Payment")

.PivotItems("Subtotal").Visible = True

.PivotItems("Local Tax").Visible = False

.PivotItems("Federal Tax ").Visible = False

End With

' Filtered values are indicated for the Month field.

ActiveSheet.PivotTables(PivotTableName).PivotFields("Month").ClearAllFilters

On Error Resume Next

With

ActiveSheet.PivotTables(PivotTableName).PivotFields("Month")

PivotSheet.PivotTables(PivotTableName).AllowMultipleFilters = True

‘The filter will make this field invisible

.PivotItems("January").Visible = False

‘The filter will make this field visible

.PivotItems("February ").Visible = True

‘The filter will make this field invisible

.PivotItems("March ").Visible = True

End With

'Sort the division field in descending order based on the by count of the discrepancies

ActiveSheet.PivotTables("PivotTable1").PivotFields("Division").AutoSort xlDescending, "Count of Discrepancy"

' This sub-routine removes all subtotals from the pivot table using a more compact and universal method than the regular macro record method, which lists all values for all variables.

Dim PivTbl As PivotTable

Dim PivFld As PivotField

On Error Resume Next

For Each PivTbl In Application.ActiveSheet.PivotTables

For Each PivFld In PivTbl.PivotFields

PivFld.Subtotals(1) = True

PivFld.Subtotals(1) = False

Next

Next

On Error GoTo 0

' Remove grand totals from rows and columns

With ActiveSheet.PivotTables("PivotTable1")

.ColumnGrand = False

.RowGrand = False

End With

' Determine the last row in the pivot table

With ActiveSheet.PivotTables("PivotTable1").TableRange1

Lastrow = ActiveSheet.UsedRange.Rows.Count

End With

‘ Format Pivot Table

ActiveSheet.PivotTables("PivotTable1").ShowTableStyleRowStripes = True

ActiveSheet.PivotTables("PivotTable1").TableStyle2 = "PivotStyleMedium9"

End Sub

' Change pivot design to "Compact"

ActiveSheet.PivotTables("PivotTable1").RowAxisLayout xlCompactRow

' Change pivot design to "Tabular"

ActiveSheet.PivotTables("PivotTable1").RowAxisLayout xlTabularRow

' Turn off the automatic calculations and screen updates, to speed up the macro.

Application.Calculation = xlManual

Application.ScreenUpdating = True

Application.DisplayStatusBar = False

Application.EnableEvents = False

' Turn on the automatic calculations and screen updates, which were deactivated so as not to slow down the macro.

Application.Calculation = xlAutomatic

Application.ScreenUpdating = True

Application.DisplayStatusBar = True

Application.EnableEvents = True

‘ Set up a separate sub for this sub-routine, then in the main sub, just type the sub (macro) name on its own.

Public Sub WaitABit()

' Wait a few seconds

Application.Wait (Now + TimeValue("00:00:02"))

End Sub

‘In the main sub, this code will run the subroutine

WaitABit

Sub UpdateWorksheetFromDifferentFile()

Dim MyFileName, FileFolder As String ' Establish the variables to store strings of text

Dim WorksheetNumber As Integer ' Establish a variable's name and sets it up to store an integer which can be very large if needed

FileFolder = "c:\testfolder\" ' Set up the variable to hold the folder path with the files

MyFileName = "Book1.xlsx" ' Set up this variable to hold the file called Book1.xlsx

Workbooks.Open (FileFolder & MyFileName) ' Open the spreadsheet file that is defined by the FileFolder and MyFileName variables

Worksheets(“Sheet1”).Activate ' Activate the worksheet called "Sheet1"

Range("A1”) = "12/16/2024" ' Input Dec 16, 2024 into cell A1 in that worksheet

ActiveWorkbook.Save ' Save the spreadsheet that is currently active

ActiveWorkbook.Close ' Close the spreadsheet that is currently active

End Sub

Sub UpdateWorksheetsFromDifferentFiles()

Dim MyFileName As String ' Establish a variable and sets it up to store a string of text

Dim FileFolder As String ' Establish a variable and sets it up to store a string of text

Dim WorksheetNumber As Long ' Set a variable to store a number which can be very large

FileFolder = "c:\testfolder\" ' Set up the variable to hold the folder path with the files

MyFileName = Dir(FileFolder) ' Set up the filename variable

Do While Len(MyFileName) > 0 ' Begin a loop that continues for all files

If MyFileName = "Book9.xlsm" Then ' This sets up an IF condition that affects the file which contains the macro code.

Exit Sub ' The code stops for the file specified by this condition.

End If ' This ends the code which applies to the IF condition.

Workbooks.open(FileFolder & MyFileName) ' Open the file

For WorksheetNumber=1 to application.worksheets. count ' Count the number of worksheets and sets the number as the upper range in this For-Next loop

Worksheets(WorksheetNumber).Activate ' Go into the Worksheet number that the For-Next loop is currently on

Range("A1") = "12/16/2024" ' Input Dec 16, 2024 into cell A1 of the active worksheet

Next WorksheetNumber ' Send the program back up to the "For" line and increas the counter by one

ActiveWorkBook.Save ' Save the active spreadsheet file

ActiveWorkBook.close ' Close the active spreadsheet file

MyFileName = Dir(FileFolder) ' Set up the filename variable

Loop ' Send the program back up to the "Do While" line, so that it repeats as long as the "Do While" condition is applicable

End Sub

Application.SendKeys (" ")

Application.SendKeys ("{BACKSPACE}")

Application.SendKeys ("{TAB}{TAB}{TAB}")

Application.SendKeys ("Michael")

Application.SendKeys ("{ENTER}")

' Set up the filename variable

FileName = Dir(FileFolder & "*")

Do While Len(FileName) > 0 ' Begin a loop that continues for all files

' Open the file

Shell AdobePdfReader & " " & FileFolder & FileName, vbMaximizedFocus

Application.SendKeys ("^a^c") ' Press CTRL-A to select all and CTRL-C to copy

' Press ALT-F4 to close Adobe

Application.SendKeys ("%{F4}")

AppActivate Title:=ThisWorkbook.Application. Caption ' Activate Excel

' Activate the worksheet

Workbooks("spreadsheet.xlsm").Worksheets("Sheet1").Activate

LastRowToCopy = ActiveSheet.Columns(1). Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 'Find the last non-blank cell in the column to copy

' Go one cell below the last cell with data in column A

Workbooks("spreadsheet.xlsm").Worksheets("Sheet1").Cells(LastRowToCopy + 1, 1).Select

ActiveSheet.Paste

' Set up the next filename variable

FileName = Dir

Loop ' Send the program back up to the "Do While" line to repeat the code

ASSIGNMENT CODE:

Sub CreateData() ' Automatic data generator

Dim RowCounter As Long

Dim ColumnCounter As Long

For ColumnCounter = 1 To 21

For RowCounter = 1 To 1001

Cells(RowCounter, ColumnCounter).Value = Round(RowCounter ^ (3 / 4) + (RowCounter * 4.3 + ColumnCounter) + ColumnCounter ^ 2, 0) ' Use this calculation to populate all of the values

If ColumnCounter > 1 And Round((Cells(RowCounter, ColumnCounter).Value) / 36, 0) = ((Cells(RowCounter, ColumnCounter).Value) / 36) Then Cells(RowCounter, ColumnCounter).Value = "" ' If the cell value is divisible by 36, make the cell blank

If (Cells(RowCounter, ColumnCounter).Value >= 65 And Cells(RowCounter, ColumnCounter).Value <= 90) Or (Cells(RowCounter, ColumnCounter).Value >= 97 And Cells(RowCounter, ColumnCounter).Value <= 122) Then Cells(RowCounter, ColumnCounter).Value = Chr(Cells(RowCounter, ColumnCounter).Value) & Cells(RowCounter, ColumnCounter).Value ' If the cell contains a value within these ranges, derive the ASCII character for that value, and place the character before the value. When these ranges are placed into the CHR function, this will result in the alphabet.

' Insert ID numbers into column A. Use zeros before the numbers so that all rows have a 4 digit ID number.

If RowCounter < 10 + 1 Then

If ColumnCounter = 1 Then Cells(RowCounter, 1).Value = "ID 000" & RowCounter - 1

ElseIf RowCounter >= 10 + 1 And RowCounter < 101 Then

If ColumnCounter = 1 Then Cells(RowCounter, 1).Value = "ID 00" & RowCounter - 1

ElseIf RowCounter >= 99 + 1 And RowCounter < 1001 Then

If ColumnCounter = 1 Then Cells(RowCounter, 1).Value = "ID 0" & RowCounter - 1

ElseIf RowCounter >= 1000 + 1 And RowCounter < 10000 Then

If ColumnCounter = 1 Then Cells(RowCounter, 1).Value = "ID " & RowCounter - 1

End If

' Label the first row with "Day " followed by the day number.

If RowCounter = 1 And ColumnCounter <= 10 Then Cells(1, ColumnCounter).Value = "Day 0" & ColumnCounter - 1

If RowCounter = 1 And ColumnCounter > 10 Then Cells(1, ColumnCounter).Value = "Day " & ColumnCounter - 1

Cells(RowCounter, ColumnCounter).HorizontalAlignment = xlRight

Next RowCounter

Next ColumnCounter

Cells(1, 1).Value = "CustID"

End Sub

SOLUTION:

Sub DataProcessingMacro()

' DRAFT 1:

' DRAFT 1: Step 1 is provided separate from this solution in the previous text.

' DRAFT 1: Step 2

' Rename the active tab

ActiveSheet.Name = "Raw Data"

ActiveSheet.Copy After:=Sheets(1) ' Duplicat the tab, places the copy after the 1st tab

' DRAFT 1: Step 3

' Rename the active tab

Sheets(2).Name = "Clean Data"

Sheets("Clean Data").Activate

' DRAFT 1: Step 4

Range("V2").FormulaR1C1 = "=SUM(RC[-21]:RC[-1])" ' Add the amounts from cells B2 to U2 (ie 21 to 1 columns to the left)

' DRAFT 1: Step 5

Range("V2").Select

Selection.Copy

Range("V3:V1001").Select

ActiveSheet.Paste

Application.CutCopyMode = False ' Remove clipboard cut/copy border (aka "ants")

Range("V1").Value = "Total"

' DRAFT 1: Step 6

Range("A1:V1").Select

' Place an autofilter on the cell selection, or remove the autofilter if there already is one

Selection.AutoFilter

' DRAFT 1: Step 7

For ColumnCounter = 1 To 21

For RowCounter = 2 To 1001

If ColumnCounter = 1 Then Cells(RowCounter, 1).Value = WorksheetFunction.Substitute(Cells(RowCounter, 1).Value, "ID ", "") ' Substitute "ID " with nothing

' DRAFT 1: Step 9

If ColumnCounter <> 1 And WorksheetFunction.IsNumber(Cells(RowCounter, ColumnCounter).Value) = True Then Cells(RowCounter, ColumnCounter).Value = Round(Cells(RowCounter, ColumnCounter).Value / 100, 2) ' Divide all numeric values by 100

' DRAFT 1: Step 10

' If the column number is divisible by 5, divide the cell value by 2

If ColumnCounter <> 1 And WorksheetFunction.IsNumber(Cells(RowCounter, ColumnCounter).Value) = True And ColumnCounter / 5 = Round(ColumnCounter / 5, 0) Then Cells(RowCounter, ColumnCounter).Value = Round(Cells(RowCounter, ColumnCounter).Value / 2, 2)

Next RowCounter

' DRAFT 1: Step 8

' Temporarily ignore errors, such as if there's no filter to begin with

On Error Resume Next

Range(Cells(2, ColumnCounter), Cells(1001, ColumnCounter)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'Delete all blank rows

'Delete all non-numeric rows

Range(Cells(2, ColumnCounter), Cells(1001, ColumnCounter)).SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete

On Error GoTo 0 ' Resume the regular error procedure which is to stop for any bugs in the code

Next ColumnCounter

' DRAFT 1: Step 11

Dim TabCounter As Integer

For TabCounter = 1 To 10

Sheets("Clean Data").Activate

' Temporarily ignore errors, such as if there's no filter to begin with

On Error Resume Next

ActiveSheet.ShowAllData ' Unfilter any filtered data

' Resume the regular error procedure which is to stop for any bugs in the code

On Error GoTo 0

ActiveSheet.Range("$A$1:$V$1001").AutoFilter Field:=1, Criteria1:=">" & (TabCounter * 100 + 1), Operator:=xlAnd

' Duplicate the tab, and plac the copy after the last tab

ActiveSheet.Copy After:=Sheets(Sheets.Count)

Sheets(Sheets.Count).Name = "ID=<" & TabCounter * 100 ' Rename the active tab

Next TabCounter

'DRAFT 2

Dim Brackets As String

For TabCounter = 1 To 10

Sheets("ID=<" & TabCounter * 100).Activate

' Temporarily ignore errors, such as if there's no filter

On Error Resume Next

ActiveSheet.ShowAllData ' Unfilter any filtered data

' Resume the regular error procedure which is to stop for any bugs

On Error GoTo 0

Brackets = ">" & (TabCounter * 100)

ActiveSheet.Range("$A$1:$V$1001").AutoFilter Field:=1, Criteria1:=Brackets

' Select only the visible cells which are not filtered.

If TabCounter <> 10 Then Range("A2:V1001").SpecialCells(xlCellTypeVisible).Select

If TabCounter <> 10 Then Selection.EntireRow.Delete

' Temporarily ignore errors, such as if there's no filter

On Error Resume Next

ActiveSheet.ShowAllData ' Unfilter any filtered data

' Resume the regular error procedure which is to stop for any bugs

On Error GoTo 0

Next TabCounter

'DRAFT 3

' DRAFT 3: Step 1

For RowCounter = 2 To 1001

If Cells(RowCounter, 1).Value < 10 Then Cells(RowCounter, 1).Value = "ID 000" & Cells(RowCounter, 1).Value

If Cells(RowCounter, 1).Value >= 10 And Cells(RowCounter, 1).Value < 100 Then Cells(RowCounter, 1).Value = "ID 00" & Cells(RowCounter, 1).Value

If Cells(RowCounter, 1).Value >= 100 And Cells(RowCounter, 1).Value < 1000 Then Cells(RowCounter, 1).Value = "ID 0" & Cells(RowCounter, 1).Value

If Cells(RowCounter, 1).Value >= 1000 And Cells(RowCounter, 1).Value < 10000 Then Cells(RowCounter, 1).Value = "ID " & Cells(RowCounter, 1).Value

Next RowCounter

For ColumnCounter = 2 To 21

Cells(1, ColumnCounter).Value = ColumnCounter - 1

Next ColumnCounter

Dim LastRowWithData As Long

' DRAFT 3: Step 2

' Temporarily ignore errors, such as if there's no filter to begin with

On Error Resume Next

Sheets("Clean Data").ShowAllData ' Unfilter any filtered data

' Resume the regular error procedure which is to stop for any bugs

On Error GoTo 0

' DRAFT 3: Step 3

' Insert a blank tab after the last tab

Sheets.Add After:=Sheets(Sheets.Count)

' DRAFT 3: Step 4

' Rename the active tab"

Sheets(Sheets.Count).Name = "Pivot"

' DRAFT 3: Step 5

Sheets("Pivot").Activate

Range("A1").Select ' Place the cursor at cell A1 in order to prepare for the search

' DRAFT 3: Step 6

LastRowWithData = Sheets("Clean Data").Columns(1).Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row ' Search through the specified column in a backwards direction from the current cursor position and provides the row number which contains the last row of text, then stores this row number in the numeric variable called LastRowWithData

' DRAFT 3: Step 7

' Create a pivot table on cell A3 of the "Pivot" tab, which has its source data in the "Clean Data" worksheet

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="Clean Data!R1C1:R" & LastRowWithData & "C21", Version:=xlPivotTableVersion12).CreatePivotTable TableDestination:="Pivot!R3C1", TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion12

' DRAFT 3: Step 8

' Insert Row Fields

With ActiveSheet.PivotTables("PivotTable1").PivotFields("CustID")

.Orientation = xlRowField

.Position = 1

End With

For ColumnCounter = 1 To 20

' Insert Value Fields

ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables("PivotTable1").PivotFields(ColumnCounter), "Sum of " & ColumnCounter, xlSum

Next ColumnCounter

' DRAFT 3: Step 9

' This sub-routine removes all subtotals from the pivot table using a more compact and universal method than the regular macro record method, which lists all values for all variables.

Dim PivTbl As PivotTable

Dim PivFld As PivotField

On Error Resume Next

For Each PivTbl In Application.ActiveSheet.PivotTables

For Each PivFld In PivTbl.PivotFields

PivFld.Subtotals(1) = True

PivFld.Subtotals(1) = False

Next

Next

On Error GoTo 0

' DRAFT 3: Step 10

ActiveSheet.PivotTables("PivotTable1").RowAxisLayout xlTabularRow ' Change pivot design to "Tabular"

' DRAFT 3: Step 11

' Remove grand totals from columns but keep them for rows

With ActiveSheet.PivotTables("PivotTable1")

.ColumnGrand = False

.RowGrand = True

End With

' DRAFT 3: Step 12

' Format Pivot Table

ActiveSheet.PivotTables("PivotTable1").ShowTableStyleRowStripes = False

ActiveSheet.PivotTables("PivotTable1").TableStyle2 = "PivotStyleMedium9"

' DRAFT 3: Step 13

Application.DisplayAlerts = False ' Select the default option on dialogue box to confirm worksheet deletion

For TabCounter = (ActiveWorkbook.Sheets.Count - 1) To 5 Step -1

Sheets(TabCounter).Delete ' Delete the worksheet tab

Next TabCounter

Application.DisplayAlerts = True ' Reset the default option on dialogue box that confirms worksheet deletion

' DRAFT 3: Step 14

Dim LastRowPivot As Long

Dim LastColumnPivot As Long

'Determine the last row in the pivot table

With ActiveSheet.PivotTables("PivotTable1").TableRange1

LastRowPivot = Sheets("Pivot").UsedRange.Rows.Count

LastColumnPivot = Sheets("Pivot").UsedRange.Columns.Count

End With

' DRAFT 3: Step 15

Sheets.Add Before:=Sheets(1) ' Insert a blank tab before the last tab

Sheets(1).Name = "Summary" ' Rename the active tab"

' DRAFT 3: Step 16

Sheets("Summary").Activate

Range("A1").Activate

Sheets("Pivot").Activate

Range(Cells(1, 1), Cells(LastRowPivot, LastColumnPivot)).Select

Selection.Copy

Sheets("Summary").Activate

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'Paste Values

Application.CutCopyMode = False ' Remove clipboard cut/copy border (aka "ants")

'DRAFT 4

' DRAFT 4: Step 1

Sheets("Clean Data").Activate

' DRAFT 4: Step 2

ActiveSheet.Copy After:=Sheets(Sheets.Count) ' Duplicate the tab, and place the copy after the 1nd tab

' DRAFT 4: Step 3

Sheets(Sheets.Count).Name = "Rearranged" ' Rename the active tab"

' DRAFT 4: Step 4

Sheets("Rearranged").Activate

' Place the cursor at cell A1 in order to prepare for the search

Range("A1").Select

LastRowWithData = ActiveSheet.Columns(1).Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row ' Search through the specified column in a backwards direction from the current cursor position and provides the row number which contains the last row of text, then stores this row number in the numeric variable called LastRowWithData

' DRAFT 4: Step 5

For ColumnCounter = 1 To 20

'Copy the values for the current day's column

Range(Cells(2, ColumnCounter + 1), Cells(LastRowWithData, ColumnCounter + 1)).Select ' Select the values in column B

Selection.Copy

' DRAFT 4: Step 6

If ColumnCounter = 1 Then Cells((LastRowWithData * ColumnCounter) + 1, 3).Select

If ColumnCounter > 1 Then Cells(((LastRowWithData - 1) * ColumnCounter) + 2, 3).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'Paste Values

' DRAFT 4: Step 7

'Copy the row labels for the current day

Range(Cells(2, 1), Cells(LastRowWithData, 1)).Select

Selection.Copy

If ColumnCounter = 1 Then Cells((LastRowWithData * ColumnCounter) + 1, 1).Select

If ColumnCounter > 1 Then Cells(((LastRowWithData - 1) * ColumnCounter) + 2, 1).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'Paste Values

' DRAFT 4: Step 8

'Copy the column label for the current day

Cells(1, ColumnCounter + 1).Select

Selection.Copy

If ColumnCounter = 1 Then Range(Cells(LastRowWithData * ColumnCounter + 1, 2), Cells(LastRowWithData * (ColumnCounter + 1) - 1, 2)).Select

If ColumnCounter > 1 Then Range(Cells((LastRowWithData - 1) * ColumnCounter + 2, 2), Cells((LastRowWithData - 1) * (ColumnCounter + 1) + 1, 2)).Select

'Paste Values

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Next ColumnCounter

' DRAFT 4: Step 9

' Delete the old table

Rows("2:770").Delete

Columns("D:V").Delete ' Delete the old table

' Label column B

Range("B1").Value = "Day"

Range("C1").Value = "Amount ($)" ' Label column B

' DRAFT 4: Step 10

' Temporarily ignore errors, such as if there's no filter

On Error Resume Next

Sheets("Clean Data").ShowAllData ' Unfilter any filtered data

' Resume the regular error procedure which is to stop for any bugs

On Error GoTo 0

Application.DisplayAlerts = False ' Select the default option on dialogue box to confirm worksheet deletion

' Delete the worksheet tab

Sheets("Pivot").Delete

Application.DisplayAlerts = True ' Reset the default option on dialogue box that confirms worksheet deletion

' Insert a blank tab after the last tab

Sheets.Add After:=Sheets(Sheets.Count)

Sheets(Sheets.Count).Name = "Pivot" ' Rename the active tab"

Sheets("Pivot").Activate

' Place the cursor at cell A1 in order to prepare for the search

Range("A1").Select

LastRowWithData = Sheets("Rearranged").Columns(1).Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row ' Search through the specified column in a backwards direction from the current cursor position and provides the row number which contains the last row of text, then stores this row number in the numeric variable called LastRowWithData

' Create a pivot table on cell A3 of the "Pivot" tab, which has its source data in the "Clean Data" worksheet

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="Rearranged!R1C1:R" & LastRowWithData & "C3", Version:=xlPivotTableVersion12).CreatePivotTable TableDestination:="Pivot!R3C1", TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion12

' Insert Row Field

With ActiveSheet.PivotTables("PivotTable1").PivotFields("CustID")

.Orientation = xlRowField

.Position = 1

End With

'The period column is set up as a column

With ActiveSheet.PivotTables("PivotTable1").PivotFields("Day")

.Orientation = xlColumnField

.Position = 1

' Insert Value Fields

End With

ActiveSheet.PivotTables("PivotTable1").AddDataField

ActiveSheet.PivotTables("PivotTable1").PivotFields("Amount ($)"), "Sum of Amount ($)", xlSum

' This sub-routine removes all subtotals from the pivot table using a more compact and universal method than the regular macro record method, which lists all values for all variables.

Dim PivTbl2 As PivotTable

Dim PivFld2 As PivotField

On Error Resume Next

For Each PivTbl2 In Application.ActiveSheet.PivotTables

For Each PivFld2 In PivTbl.PivotFields

PivFld2.Subtotals(1) = True

PivFld2.Subtotals(1) = False

Next

Next

On Error GoTo 0

' Remove grand totals from columns but keep them for rows

With ActiveSheet.PivotTables("PivotTable1")

.ColumnGrand = False

.RowGrand = True

End With

' Change pivot design to "Tabular"

ActiveSheet.PivotTables("PivotTable1").RowAxisLayout xlTabularRow

' Format Pivot Table

ActiveSheet.PivotTables("PivotTable1").ShowTableStyleRowStripes = False

ActiveSheet.PivotTables("PivotTable1").TableStyle2 = "PivotStyleMedium9"

' DRAFT 4: Step 11

' Select the default option on dialogue box to confirm worksheet deletion

Application.DisplayAlerts = False

Sheets("Summary").Delete ' Delete the worksheet tab

' Reset the default option on dialogue box that confirms worksheet deletion

Application.DisplayAlerts = True

'Dim LastRowPivot As Long ' Remove apostrophe before Dim if the following section of code is separated from the code above

'Dim LastColumnPivot As Long' Remove apostrophe before Dim if the following section of code is separated from the code above

'Determine the last row in the pivot table

With ActiveSheet.PivotTables("PivotTable1").TableRange1

LastRowPivot = Sheets("Pivot").UsedRange.Rows.Count

LastColumnPivot = Sheets("Pivot").UsedRange.Columns.Count

End With

' Insert a blank tab before the last tab

Sheets.Add Before:=Sheets(1)

Sheets(1).Name = "Summary" ' Rename the active tab"

Sheets("Summary").Activate

Range("A1").Activate

Sheets("Pivot").Activate

Range(Cells(1, 1), Cells(LastRowPivot, LastColumnPivot)).Select

Selection.Copy

Sheets("Summary").Activate

'Paste Values

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False ' Remove clipboard cut/copy border (aka "ants")

End Sub