microsoft_excel:macros:macro_full_example_program
Microsoft Excel - Macros - Macro Full Example Program
' Options ' Option Explicit forces you to declare all your variables. Option Explicit ' Makes all "text comparisons" case insensitive Option Compare Text '****************************************************************************** ' Window API Declarations ' These Declares MUST appear at the top of the code module, above and before any VBA procedures. 'Const HWND_BOTTOM = 1 Const SWP_NOSIZE = &H1 Const SWP_NOMOVE = &H2 Const SWP_NOACTIVATE = &H10 Const SWP_SHOWWINDOW = &H40 Public Const HWND_TOPMOST = -1 Public Const HWND_NOTOPMOST = -2 Public Const HWND_TOP = 0 Public Const HWND_BOTTOM = 1 ' http://www.tek-tips.com/faqs.cfm?fid=4699 ' ' Message boxes are always modal, which means that the underlying application (e.g. Excel) waits for a response from ' the User and does not allow any other interaction until one is given. ' By default they are application modal (they remain in front of all other windows belonging to the owning application ' but have no impact on other applications), but they may also be system modal (they remain in front of ALL other ' windows although they have no non-visual impact on applications other than the owning one). ' ' Use the Message Box facility directly, via the Windows API, instead of via the VBA interface. ' Using it is pretty much the same as using MsgBox, except that you have the opportunity to set some parameter values ' which are defaulted in the VBA interface, in particular the message box, although technically still modal, can be ' attached to any window, or none. If you do not attach it to your window, it will not restrict your User's interaction ' with the application. Private Declare Function MessageBox _ Lib "user32" Alias "MessageBoxA" _ (ByVal hwnd As Long, _ ByVal lpText As String, _ ByVal lpCaption As String, _ ByVal wType As Long) _ As Long ' Used to have XL be on top of all other windows. #If Win64 Then Public Declare PtrSafe Function SetWindowPos _ Lib "user32" ( _ ByVal hwnd As LongPtr, _ ByVal hwndInsertAfter As LongPtr, _ ByVal x As Long, _ ByVal y As Long, _ ByVal cx As Long, _ ByVal cy As Long, _ ByVal wFlags As Long) _ As Long #Else Public Declare Function SetWindowPos _ Lib "user32" ( _ ByVal hwnd As Long, _ ByVal hwndInsertAfter As Long, _ ByVal x As Long, _ ByVal y As Long, _ ByVal cx As Long, _ ByVal cy As Long, _ ByVal wFlags As Long) _ As Long #End If '****************************************************************************** ' Some public variables. Public wb_name As String ' Workbook Name Public ctrl_disable_auto_calcs_before_subroutine As Boolean Public ctrl_reenable_auto_calcs_after_subroutine As Boolean Public ctrl_ask_before_running_subroutine As Boolean Public ctrl_show_dashboard_after_subroutine As Boolean Public ctrl_close_erroneous_files As Boolean Public ctrl_display_sheet_adding_error As Boolean Public ctrl_use_system_modal_messages As Boolean Public ctrl_clear_formatting_as_well As Boolean Public ctrl_processing_type As Long Sub ShowXLOnTop(ByVal OnTop As Boolean) Dim xStype As Long #If Win64 Then Dim xHwnd As LongPtr #Else Dim xHwnd As Long #End If If OnTop Then xStype = HWND_TOPMOST Else xStype = HWND_NOTOPMOST End If Call SetWindowPos(Application.hwnd, xStype, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE) End Sub ' Sets that XL is the top window of all applications. Sub SetXLOnTop() ShowXLOnTop True End Sub ' Sets that XL is not necessarily the top windows of all applications. ' If this were not run at some stage then no other application, such as mail, would be able to be seen. Sub SetXLNormal() ShowXLOnTop False End Sub ' Scrolls the worksheet to the specific range. ' For instance ScrollTo "SHEETNAME1", "A1" Sub ScrollTo(ws As String, rng As String) Application.GoTo Worksheets(ws).Range(rng), True Worksheets(ws).Range(rng).Select End Sub ' Removes AutoFilter if one exists. Sub TurnFilterOffAllSheets() Dim ws As Worksheet For Each ws In ActiveWorkbook.Worksheets With ws .AutoFilterMode = False End With Next ws End Sub ' Delete all unused blank rows and columns in the sheet. ' Note: This code may not work correctly if the worksheet contains merged cells. Sub DeleteUnusedOnSheet(ws As String) Dim myLastRow As Long Dim myLastCol As Long Dim wks As Worksheet With Worksheets(ws) myLastRow = 0 myLastCol = 0 On Error Resume Next myLastRow = _ .Cells.Find("*", after:=.Cells(1), _ LookIn:=xlFormulas, lookat:=xlWhole, _ searchdirection:=xlPrevious, _ searchorder:=xlByRows).Row myLastCol = _ .Cells.Find("*", after:=.Cells(1), _ LookIn:=xlFormulas, lookat:=xlWhole, _ searchdirection:=xlPrevious, _ searchorder:=xlByColumns).Column On Error GoTo 0 If myLastRow * myLastCol = 0 Then .Columns.Delete Else .Range(.Cells(myLastRow + 1, 1), _ .Cells(.Rows.Count, 1)).EntireRow.Delete .Range(.Cells(1, myLastCol + 1), _ .Cells(1, .Columns.Count)).EntireColumn.Delete End If End With End Sub ' Displays a message to the user, optionally adding in how long the process ran and the queryname. ' Depending on the Developer Control settings it will display a System modal message. Function Message(msg As String, Optional elapsedtime As Single, Optional queryname As String) Dim msg_to_show As String msg_to_show = msg If Not IsMissing(elapsedtime) And elapsedtime > 0 Then If msg_to_show <> "" Then msg_to_show = msg_to_show & vbCrLf & vbCrLf End If If Not IsMissing(queryname) Then msg_to_show = msg_to_show & "The query """ & queryname & """ took " & elapsedtime _ & " seconds to run." Else msg_to_show = msg_to_show & "The query took " & elapsedtime & " seconds to run." End If End If If ctrl_use_system_modal_messages = True Then If Not IsMissing(queryname) Then MessageBox &H0, msg_to_show, wb_name & "-" & queryname, vbSystemModal Else MessageBox &H0, msg_to_show, wb_name, vbSystemModal End If Else MsgBox msg_to_show End If End Function ' Initializes global variables. ' These variables are set within the "Developer Control" sheet, and allow overrides of specific functionality within other subroutines. Sub Z00000_Init() ' Set a shortcut to the workbook. wb_name = ThisWorkbook.name ' Set public variables from the Developer Control Sheet. ctrl_disable_auto_calcs_before_subroutine = Workbooks(wb_name).Sheets("Developer Control").Range("H11") ctrl_reenable_auto_calcs_after_subroutine = Workbooks(wb_name).Sheets("Developer Control").Range("H13") ctrl_ask_before_running_subroutine = Workbooks(wb_name).Sheets("Developer Control").Range("H15") ctrl_show_dashboard_after_subroutine = Workbooks(wb_name).Sheets("Developer Control").Range("H19") ctrl_close_erroneous_files = Workbooks(wb_name).Sheets("Developer Control").Range("H21") ctrl_display_sheet_adding_error = Workbooks(wb_name).Sheets("Developer Control").Range("H23") ctrl_use_system_modal_messages = Workbooks(wb_name).Sheets("Developer Control").Range("H25") ctrl_clear_formatting_as_well = Workbooks(wb_name).Sheets("Developer Control").Range("H27") ctrl_processing_type = Workbooks(wb_name).Sheets("Developer Control").Range("H30") End Sub ' Runs whichever subroutine name is passed to it. ' This is the 'master' controlling routine, which also times how long other routines take and displays messages. Sub Z99999_Run_Subroutine(strQueryName As String, Optional strDescription As String = "") Dim sngStart As Single Dim sngEnd As Single Dim sngElapsed As Single ' Control to prevent user from overwriting the template. If ThisWorkbook.name Like "* Template.xlsm" Then MsgBox "This workbook is the template, you must not make changes to it." & vbCrLf & vbCrLf & "You need to save as a new workbook name before running any macros." Exit Sub End If ' Get start time. sngStart = Timer ' Initializes global variables. Call Z00000_Init ' To speed up processing. If ctrl_disable_auto_calcs_before_subroutine Then With Application .Calculation = xlCalculationManual .EnableEvents = False .ScreenUpdating = False End With End If ' Turn filters off on all sheets. Call TurnFilterOffAllSheets ' Update StatusBar message. If strDescription = "" Then Application.StatusBar = "Running " & strQueryName Else Application.StatusBar = "Running " & strDescription End If ' Run query. 'DoCmd.OpenQuery strQueryName, acNormal 'Call strQueryName Application.Run strQueryName ' Re-enable automatic calculations. If ctrl_reenable_auto_calcs_after_subroutine Then With Application .Calculation = xlCalculationAutomatic .EnableEvents = True .ScreenUpdating = True End With End If ' Activate the dashboard. If ctrl_show_dashboard_after_subroutine Then Workbooks(wb_name).Sheets("Dashboard").Activate End If ' Display how long the subroutine ran for. sngEnd = Timer ' Get end time. sngElapsed = Format(sngEnd - sngStart, "Fixed") ' Elapsed time. ' Make excel top most to bring it to the top of other applications. SetXLOnTop ' Display message to user. If strDescription = "" Then Message "", sngElapsed, strQueryName Application.StatusBar = "Finished " & strQueryName Else Message "", sngElapsed, strDescription Application.StatusBar = "Finished " & strDescription End If ' Make excel not top most to allow other applications to go on top of it. SetXLNormal End Sub ' Runs the M10000_Clear_All subroutine. ' Clears all sheets, but leaves the forumulas which are in the 2nd row on most sheets. Sub Run_M10000_Clear_All() Call Z99999_Run_Subroutine("M10000_Clear_All", "Clear all") End Sub ' Runs the M10030_Reset_Formulae subroutine. ' Writes all formulae into the 2nd row on all sheets. ' Usually the green column headings indicate which have formulae. Sub Run_M10030_Reset_Formulae() Call Z99999_Run_Subroutine("M10030_Reset_Formulae", "Reset Formulae") End Sub ' Runs the M10040_Refresh_Queries subroutine. ' Refreshes all queries on all sheets. Sub Run_M10040_Refresh_Queries() Call Z99999_Run_Subroutine("M10040_Refresh_Queries", "Refresh Queries") End Sub ' Runs the M10100_Import_FinalABC subroutine. ' Imports the FinalABC file. Sub Run_M10100_Import_FinalABC() Call Z99999_Run_Subroutine("M10100_Import_FinalABC", "Import FinalABC") End Sub ' Runs the M10110_Copy_Pre_FinalABC_Formulae_Down subroutine. ' Copy initial formulae down on the FinalABC sheet. ' Just enough data to allow the sheet to be later sorted and for the Mapping Pivots to be created. Sub Run_M10110_Copy_Pre_FinalABC_Formulae_Down() Call Z99999_Run_Subroutine("M10110_Copy_Pre_FinalABC_Formulae_Down", "Copy pre-FinalABC formulae down") End Sub ' Runs the M10120_Sort_FinalABC_column_A subroutine. ' Sort FinalABC on column A in ascending order. Sub Run_M10120_Sort_FinalABC_column_A() Call Z99999_Run_Subroutine("M10120_Sort_FinalABC_column_A", "Sort FinalABC") End Sub ' Runs the M10200_Refresh_Mapping_Pivots subroutine. ' Refresh the Mapping Pivots. ' These only depend on the FinalABC sheet. Sub Run_M10200_Refresh_Mapping_Pivots() Call Z99999_Run_Subroutine("M10200_Refresh_Mapping_Pivots", "Refresh Mapping Pivots") End Sub ' Runs the M10300_Import_SHEETNAME1_from_Auto subroutine. ' Import data into the SHEETNAME1 sheet from the "SHEETNAME1 - Auto" sheet instead of from a file. ' The "SHEETNAME1 - Auto" sheet is populated from a query against G3. Sub Run_M10300_Import_SHEETNAME1_from_Auto() Call Z99999_Run_Subroutine("M10300_Import_SHEETNAME1_from_Auto", "Import SHEETNAME1 from Auto") End Sub ' Runs the M10300_Import_SHEETNAME1 subroutine. ' Filename must be in the format SHEETNAME1CCYYMMDD.csv. ' If not MMDD available then use 9999 in their place. Sub Run_M10300_Import_SHEETNAME1() Call Z99999_Run_Subroutine("M10300_Import_SHEETNAME1", "Import SHEETNAME1 from a file") End Sub ' Runs the M10400_Update_FinalABC_Formulae subroutine. ' Updates the formulae on the FinalABC sheet to only reference the specific number of rows actually loaded into the ' FinalABC sheet instead of something like A:A which would reference over 1 million rows and therefore may slow down ' calculations etc. Sub Run_M10400_Update_FinalABC_Formulae() Call Z99999_Run_Subroutine("M10400_Update_FinalABC_Formulae", "Update FinalABC formulae") End Sub ' Runs the M10410_Copy_Post_FinalABC_Formulae_Down subroutine. ' Copy the updated formula on the FinalABC sheet down for all populated rows. Sub Run_M10410_Copy_Post_FinalABC_Formulae_Down() Select Case ctrl_processing_type Case 1 Call Z99999_Run_Subroutine("M10415_Copy_Post_FinalABC_Formulae_Down_Array", "Copy post-FinalABC formulae down") Case 2 Call Z99999_Run_Subroutine("M10410_Copy_Post_FinalABC_Formulae_Down", "Copy post-FinalABC formulae down") Case Else Call Z99999_Run_Subroutine("M10415_Copy_Post_FinalABC_Formulae_Down_Array", "Copy post-FinalABC formulae down") End Select End Sub ' Runs the M10500_Copy_Pre_SHEETNAME1_Formulae_Down subroutine. ' Copy pre SHEETNAME1 formula down. ' Just enough data to allow SHEETNAME1 sheet to be sorted. Sub Run_M10500_Copy_Pre_SHEETNAME1_Formulae_Down() Select Case ctrl_processing_type Case 1 Call Z99999_Run_Subroutine("M10505_Copy_Pre_SHEETNAME1_Formulae_Down_array", "Copy pre-SHEETNAME1 formulae down") Case 2 Call Z99999_Run_Subroutine("M10500_Copy_Pre_SHEETNAME1_Formulae_Down", "Copy pre-SHEETNAME1 formulae down") Case Else Call Z99999_Run_Subroutine("M10505_Copy_Pre_SHEETNAME1_Formulae_Down_array", "Copy pre-SHEETNAME1 formulae down") End Select End Sub ' Runs the M10510_Sort_SHEETNAME1_column_A subroutine. ' Sorts the SHEETNAME1 sheet by Column A and M in ascending order. Sub Run_M10510_Sort_SHEETNAME1_column_A() Call Z99999_Run_Subroutine("M10510_Sort_SHEETNAME1_column_A", "Sort SHEETNAME1") End Sub ' Runs the M10520_Update_SHEETNAME1_Formulae subroutine. ' Updates the formulae on the SHEETNAME1 sheet to only reference the specific number of rows actually loaded into the SHEETNAME1 sheet ' instead of something like A:A which would reference over 1 million rows and therefore may slow down calculations etc. Sub Run_M10520_Update_SHEETNAME1_Formulae() Select Case ctrl_processing_type Case 1 Call Z99999_Run_Subroutine("M10520_Update_SHEETNAME1_Formulae", "Update SHEETNAME1 formulae") Case 2 Call Z99999_Run_Subroutine("M10520_Update_SHEETNAME1_Formulae", "Update SHEETNAME1 formulae") Case Else Call Z99999_Run_Subroutine("M10520_Update_SHEETNAME1_Formulae", "Update SHEETNAME1 formulae") End Select End Sub ' Runs the M10535_Copy_Post_SHEETNAME1_Formulae_Down_Array subroutine. ' Speedy - copies using arrays. ' Copies remaining formulae down on the SHEETNAME1 sheet. Sub Run_M10535_Copy_Post_SHEETNAME1_Formulae_Down_Array() Call Z99999_Run_Subroutine("M10535_Copy_Post_SHEETNAME1_Formulae_Down_Array", "Copy post-SHEETNAME1 formulae down") End Sub ' Runs the M10540_Copy_Post_SHEETNAME1_Formulae_Down subroutine. ' Copies remaining formulae down on the SHEETNAME1 sheet. Sub Run_M10540_Copy_Post_SHEETNAME1_Formulae_Down() Select Case ctrl_processing_type Case 1 Call Z99999_Run_Subroutine("M10535_Copy_Post_SHEETNAME1_Formulae_Down_Array", "Copy post-SHEETNAME1 formulae down") Case 2 Call Z99999_Run_Subroutine("M10540_Copy_Post_SHEETNAME1_Formulae_Down", "Copy post-SHEETNAME1 formulae down") Case Else Call Z99999_Run_Subroutine("M10535_Copy_Post_SHEETNAME1_Formulae_Down_Array", "Copy post-SHEETNAME1 formulae down") End Select End Sub ' Runs the M10600_Copy_More_FinalABC_Formulae_Down subroutine. ' Now that both Final and SHEETNAME1 sheets populated, need to action some more formula calculations. Sub Run_M10600_Copy_More_FinalABC_Formulae_Down() Call Z99999_Run_Subroutine("M10600_Copy_More_FinalABC_Formulae_Down", "Copy more FinalABC formulae down") End Sub ' Runs the M10610_Reformat_FinalABC_Corrected_Dates subroutine. ' Adds 1 to the Corrected Date, column E, in the FinalABC sheet for dates that were the last date of the month. ' It then recalculates the sheet to determine if column AJ now reconciles, i.e. shows "MATCHED GROSS AMOUNT ISIN BY MONTH". ' This requires the following columns to have formulae throughout: E, L, K, AI, AJ Sub Run_M10610_Reformat_FinalABC_Corrected_Dates() Call Z99999_Run_Subroutine("M10610_Reformat_FinalABC_Corrected_Dates", "Reformat FinalABC corrected dates") End Sub ' Runs the M10620_Recalc_SHEETNAME1_Formulae subroutine. ' Copies remaining formulae down on the SHEETNAME1 sheet. Sub Run_M10620_Recalc_SHEETNAME1_Formulae() Select Case ctrl_processing_type Case 1 Call Z99999_Run_Subroutine("M10615_Recalc_SHEETNAME1_Formulae_Array", "Recalc SHEETNAME1 formulae") Case 2 Call Z99999_Run_Subroutine("M10625_Recalc_SHEETNAME1_Formulae", "Recalc SHEETNAME1 formulae") Case Else Call Z99999_Run_Subroutine("M10615_Recalc_SHEETNAME1_Formulae_Array", "Recalc SHEETNAME1 formulae") End Select End Sub ' Runs the M10700_Format_FinalABC_lines subroutine. ' Format the FinalABC sheet to put lines between ISINs. Sub Run_M10700_Format_FinalABC_lines() Call Z99999_Run_Subroutine("M10700_Format_FinalABC_lines", "Format FinalABC lines") End Sub ' Runs the M10710_Format_SHEETNAME1_Lines subroutine. ' Format the SHEETNAME1 sheet by placing lines between ISINs. Sub Run_M10710_Format_SHEETNAME1_Lines() Call Z99999_Run_Subroutine("M10710_Format_SHEETNAME1_Lines", "Format SHEETNAME1 lines") End Sub ' Runs the M10800_Refresh_Rec_Dashboard_Pivots subroutine. ' Refresh the PIVOT tables on the REC DASHBOARD sheet. Sub Run_M10800_Refresh_Rec_Dashboard_Pivots() Call Z99999_Run_Subroutine("M10800_Refresh_Rec_Dashboard_Pivots", "Refresh REC-Dashboard pivots") End Sub ' Runs the M10810_Refresh_Adj_Dashboard_Pivots subroutine. ' Refresh the PIVOT tables on the ADJ DASHBOARD sheet. Sub Run_M10810_Refresh_Adj_Dashboard_Pivots() Call Z99999_Run_Subroutine("M10810_Refresh_Adj_Dashboard_Pivots", "Refresh ADJ-Dashboard pivots") End Sub ' Runs the M10910_Revert_Reformatted_FinalABC_Corrected_Dates subroutine. ' Reverts the Corrected Date, column E, in the FinalABC sheet back to its original calculated date. ' It only does this for cells where column AJ does not still reconciles, i.e. does not show "MATCHED GROSS AMOUNT ISIN BY MONTH". ' This requires the following columns to have formulae throughout: E, L, K, AI, AJ Sub Run_M10910_Revert_Reformatted_FinalABC_Corrected_Dates() Call Z99999_Run_Subroutine("M10910_Revert_Reformatted_FinalABC_Corrected_Dates", "Revert reformatted FinalABC corrected dates") End Sub ' Runs the M11000_Clear_SHEETNAME1_lines subroutine. ' Clears formatting on the SHEETNAME1 sheet. ' Removes the lines between ISINs. Sub Run_M11000_Clear_SHEETNAME1_lines() Call Z99999_Run_Subroutine("M11000_Clear_SHEETNAME1_lines", "Clear SHEETNAME1 lines") End Sub ' Runs the M1110_Clear_FinalABC_lines subroutine. ' Clears formatting on the FinalABC sheet. Removes the lines between ISINs. Sub Run_M11110_Clear_FinalABC_lines() Call Z99999_Run_Subroutine("M11110_Clear_FinalABC_lines", "Clear FinalABC lines") End Sub ' Runs the M11200_Recalc_changed_adjusted_rows subroutine. ' For any row that has adjusted values different than the original value it recalculates the values against that row. ' It does this by putting formulae back in only for the specific row and then performing the recalc. ' Later the formula are replaced by values again. Sub Run_M11200_Recalc_changed_adjusted_rows() Select Case ctrl_processing_type Case 1 Call Z99999_Run_Subroutine("M11205_Recalc_changed_adjusted_rows_Array_NEW", "Recalc changed adjusted rows") 'Call Z99999_Run_Subroutine("M11200_Recalc_changed_adjusted_rows_Array", "Recalc changed adjusted rows") Case 2 Call Z99999_Run_Subroutine("M11210_Recalc_changed_adjusted_rows", "Recalc changed adjusted rows") Case Else Call Z99999_Run_Subroutine("M11200_Recalc_changed_adjusted_rows_Array", "Recalc changed adjusted rows") End Select End Sub ' Runs the M11207_Recalc_changed_adjusted_rows subroutine. ' This prompt the user for a row in the SHEETNAME1 sheet. ' It then recalculates the values against that row. ' It does this by putting formulae back in only for the specific row and then performing the recalc. ' Later the formula are replaced by values again. Sub Run_M11207_Recalc_changed_adjusted_rows() Call Z99999_Run_Subroutine("M11207_Recalc_changed_adjusted_rows_Array_NEW", "Recalc changed adjusted rows - SHEETNAME1") End Sub ' Runs the M11208_Recalc_changed_adjusted_rows subroutine. ' This prompt the user for a row in the FinalABC sheet. ' It then recalculates the values against that row. ' It does this by putting formulae back in only for the specific row and then performing the recalc. ' Later the formula are replaced by values again. Sub Run_M11208_Recalc_changed_adjusted_rows() Call Z99999_Run_Subroutine("M11208_Recalc_changed_adjusted_rows_Array_NEW", "Recalc changed adjusted rows - FinalABC") End Sub ' Runs the M12000_Copy_FinalABC_Formulae_Down subroutine. ' Copies all formulae down on the FinalABC sheet. ' Does not change the formula to values. For that use the seperate subroutine. ' Does not calculate. This needs to be requested seperately when needed. Probably only once the SHEETNAME1 sheet populated too. ' This may run for a very long time. Go have a coffee. Sub Run_M12000_Copy_FinalABC_Formulae_Down() Call Z99999_Run_Subroutine("M12000_Copy_FinalABC_Formulae_Down", "Copy FinalABC formulae down") End Sub ' Runs the M12010_Convert_FinalABC_Formulae_to_Values subroutine. ' Converts all formulae on the FinalABC sheet to Values. ' Does not change row 2 of the FinalABC sheet. This retains the formulae in this row. ' This may run for a very long time. Go have a coffee. Sub Run_M12010_Convert_FinalABC_Formulae_to_Values() Call Z99999_Run_Subroutine("M12010_Convert_FinalABC_Formulae_to_Values", "Convert FinalABC formulae to values") End Sub ' Runs the M12020_Copy_SHEETNAME1_Formulae_Down subroutine. ' Copies down all formulae on the SHEETNAME1 sheet. ' Does not change the formula to values. For that use the seperate subroutine. ' Does not calculate. This needs to be requested seperately when needed. Probably only once the FinalABC sheet populated too. ' This may run for a very long time. Go have a coffee. Sub Run_M12020_Copy_SHEETNAME1_Formulae_Down() Call Z99999_Run_Subroutine("M12020_Copy_SHEETNAME1_Formulae_Down", "Copy SHEETNAME1 formulae down") End Sub ' Runs the M12030_Convert_SHEETNAME1_Formulae_to_Values subroutine. ' Converts all formula cells on the SHEETNAME1 sheet into values. ' Does not change row 2 of the SHEETNAME1 sheet. This retains the formulae in this row. ' This may run for a very long time. Go have a coffee. Sub Run_M12030_Convert_SHEETNAME1_Formulae_to_Values() Call Z99999_Run_Subroutine("M12030_Convert_SHEETNAME1_Formulae_to_Values", "Convert SHEETNAME1 formulae to values") End Sub ' Runs the M13000_Import_Wxxxx subroutine. ' Imports the Wxxxx file into the Wxxxx tab. ' This also sorts the result and places in formulas. Sub Run_M13000_Import_Wxxxx() Call Z99999_Run_Subroutine("M13000_Import_Wxxxx", "Import Wxxxx") End Sub ' Clears all sheets, but leaves the formulae which are in the 2nd row on most sheets. Sub M10000_Clear_All() ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Clear all sheets?", vbYesNo) = vbNo Then Exit Sub End If ' Clear the SHEETNAME1 sheet. Call M10010_Clear_SHEETNAME1 ' Clear the FinalABC sheet. Call M10020_Clear_FinalABC End Sub ' Clears the SHEETNAME1 sheet, but leaves the formulae which are in the 2nd row. Sub M10010_Clear_SHEETNAME1() Dim lastrow_SHEETNAME1 As Long ' Last row in the SHEETNAME1 sheet Dim rng As Range Dim i As Long ' Initialize global vars. Call Z00000_Init ' Ask user. 'If ctrl_ask_before_running_subroutine = True Then ' If MsgBox("Clear the SHEETNAME1 sheet?", vbYesNo) = vbNo Then Exit Sub 'End If ' Update StatusBar. Application.StatusBar = "Clearing SHEETNAME1 sheet..." With Workbooks(wb_name) With .Sheets("SHEETNAME1") ' Activate the sheet. .Activate ' Get how many rows of data have been loaded into the sheet. lastrow_SHEETNAME1 = .Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_SHEETNAME1 < 3 Then lastrow_SHEETNAME1 = 3 End If ' Set entire range to blank. Set rng = .Range("A3:BO" & lastrow_SHEETNAME1) rng.Value = "" ' Clear entire sheet, except for row 2 which contains formulae. ' Uses ClearContents instead of Delete as much quicker. ' ClearContents only clears the cell value and not the formatting if any. For i = lastrow_SHEETNAME1 To 3 Step -1 .Rows(i).ClearContents Next i ' Clear fields loaded from SHEETNAME1 file. .Range("C2:E" & lastrow_SHEETNAME1).ClearContents .Range("G2:G" & lastrow_SHEETNAME1).ClearContents .Range("I2:I" & lastrow_SHEETNAME1).ClearContents .Range("N2:S" & lastrow_SHEETNAME1).ClearContents .Range("U2:U" & lastrow_SHEETNAME1).ClearContents ' Clear formatting. If ctrl_clear_formatting_as_well = True Then .Range("A3:BO" & lastrow_SHEETNAME1).ClearFormats .Range("C2:E" & lastrow_SHEETNAME1).ClearFormats .Range("G2:G" & lastrow_SHEETNAME1).ClearFormats .Range("I2:I" & lastrow_SHEETNAME1).ClearFormats .Range("N2:S" & lastrow_SHEETNAME1).ClearFormats .Range("U2:U" & lastrow_SHEETNAME1).ClearFormats End If ' Clear any double lines. These are used to flag where the ISIN changes. .Range("A1:BO" & lastrow_SHEETNAME1).Borders.LineStyle = xlNone ' Reset font to standard. .Range("A2:BO" & lastrow_SHEETNAME1).Font.name = Application.StandardFont ' Delete all unused rows and columns in the sheet. DeleteUnusedOnSheet ("SHEETNAME1") End With End With ' Do calculation. With Application .Calculate End With ' Clear all objects. Set rng = Nothing End Sub ' Clears the FinalABC sheet, but leaves the formulae which are in the 2nd row. Sub M10020_Clear_FinalABC() Dim lastrow_FinalABC As Long ' Last row in the FinalABC sheet Dim rng As Range ' Initialize global vars. Call Z00000_Init ' Ask user. 'If ctrl_ask_before_running_subroutine = True Then ' If MsgBox("Clear the FinalABC sheet?", vbYesNo) = vbNo Then Exit Sub 'End If ' Update StatusBar. Application.StatusBar = "Clearing FinalABC sheet..." With Workbooks(wb_name) With .Sheets("FinalABC") ' Activate the sheet. .Activate ' Get how many rows of data have been loaded into the sheet. lastrow_FinalABC = .Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_FinalABC < 3 Then lastrow_FinalABC = 3 End If ' Clear entire sheet, except for row 2 which contains formulae. .Range("A3:AT" & lastrow_FinalABC).ClearContents ' Clear fields loaded from BBH file. .Range("D2:D" & lastrow_FinalABC).ClearContents .Range("F2:I" & lastrow_FinalABC).ClearContents .Range("O2:O" & lastrow_FinalABC).ClearContents .Range("S2:AH" & lastrow_FinalABC).ClearContents ' Clear formatting. If ctrl_clear_formatting_as_well = True Then .Range("A3:AT" & lastrow_FinalABC).ClearFormats .Range("D2:D" & lastrow_FinalABC).ClearFormats .Range("F2:I" & lastrow_FinalABC).ClearFormats .Range("O2:O" & lastrow_FinalABC).ClearFormats .Range("S2:AH" & lastrow_FinalABC).ClearFormats End If ' Clear any double lines. These are used to flag where the ISIN changes. .Range("A1:AT" & lastrow_FinalABC).Borders.LineStyle = xlNone ' Reset font to standard. .Range("A3:AT" & lastrow_FinalABC).Font.name = Application.StandardFont ' This deletes empty rows at the bottom of the sheet. Important to save after this is run to commit this change. ' This substantially reduces the size of the sheet, especially in larger Excel sheets going down to over 1 Million rows. '.Range("A" & lastrow_FinalABC & ":AT" & Rows.Count).EntireRow.Delete ' Delete all unused black rows and columns in the sheet. DeleteUnusedOnSheet ("FinalABC") ' Control to confirm there is currently no data in the blue columns in the FinalABC sheet. If WorksheetFunction.CountA( _ .Range("D2:D" & lastrow_FinalABC), _ .Range("F2:I" & lastrow_FinalABC), _ .Range("O2:O" & lastrow_FinalABC), _ .Range("S2:AH" & lastrow_FinalABC)) > 0 Then Message "There is data still present in the blue columns in the FinalABC sheet, these should be blank. Ensure they are empty before running this process." Exit Sub End If End With End With ' Do calculation. With Application .Calculate End With ' Clear all objects. Set rng = Nothing End Sub ' Writes all formulae into the 2nd row on all sheets. ' Usually the green column headings indicate which have formulae. Sub M10030_Reset_Formulae() ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Reset all Formulae?", vbYesNo) = vbNo Then Exit Sub End If ' Update StatusBar. Application.StatusBar = "Resetting Formulae..." With Workbooks(wb_name) ' Resets formulae on TRANSACTIONS. 'With .Sheets("TRANSACTIONS") ' .Activate ' .Range("A2").Formula = "=B2&F2&K2" 'End With ' Resets formulae on SHEETNAME1. With .Sheets("SHEETNAME1") .Activate ' Update StatusBar. Application.StatusBar = "Resetting Formulae...on SHEETNAME1" .Range("A2").Formula = "=B2&"" - ""&TEXT(C2,""MMM"")&"" ""&YEAR(C2)" .Range("B2").Formula = "=IFERROR(VLOOKUP(N2,SECT!A:B,2,FALSE),"""")" .Range("F2").Formula = "=IF(X2=""EXCLUDE"",0,G2)" .Range("H2").Formula = "=G2-J2" .Range("J2").Formula = "=IF(K2="""",I2,IF(L2="""",I2,IF(OR(L2=0,K2=0),0,I2/(L2/K2))))" .Range("L2").Formula = "=IF(G2=0,0,I2/G2)" .Range("M2").Formula = "=VLOOKUP(U2,References!A:B,2,FALSE)" .Range("T2").Formula = "=VLOOKUP(R2,CUST!A:B,2,FALSE)" .Range("V2").Formula = "=IF(ISNA(VLOOKUP(B2,FinalABC!$D:$D,1,FALSE)),""NON EXIST"",""EXIST"")" .Range("W2").Formula = "=B2=B1" .Range("X2").Formula = "=IF(ISNA(VLOOKUP(A2,FinalABC!A:A,1,FALSE)),""NON EXIST"",""EXIST"")" .Range("AB2").Formula = "=IF(OR(X2=""NON EXIST"",Y2=""EXCLUDE""),""NON REPORTABLE"",A2&"" - ""&ROUND(F2,0))" .Range("AC2").Formula = "=IF(OR($X2=""NON EXIST"",$Y2=""EXCLUDE""),""NON REPORTABLE"",IFERROR(VLOOKUP($A2,'Mapping Pivots'!$A:$B,2,FALSE), IFERROR(VLOOKUP($AB2,'Mapping Pivots'!$F:$G,2,FALSE), ""MANUAL INPUT"")))" .Range("AE2").Formula = "=IF(OR($X2=""NON EXIST"",$Y2=""EXCLUDE""),""NON REPORTABLE"",IFERROR(VLOOKUP($A2,'Mapping Pivots'!$A:$C,3,FALSE),IFERROR(VLOOKUP($AB2,'Mapping Pivots'!$F:$H,3,FALSE), ""MANUAL INPUT"")))" .Range("AG2").Formula = "=IF(OR($X2=""NON EXIST"",$Y2=""EXCLUDE""),""NON REPORTABLE"",IF(COUNTIF($A$1:A2,A2)>1,""AGGREGATE"",ROUND(SUMIF($A:$A,A2,$J:$J)-SUMIF(FinalABC!$A:$A,A2,FinalABC!$N:$N),2)))" .Range("AH2").Formula = "=IF(AG2=""NON REPORTABLE"",AG2,IF(AND(ROUND(SUMIFS($J:$J,$A:$A,A2,$Y:$Y,""INCLUDE"")-SUMIF(FinalABC!$A:$A,A2,FinalABC!$N:$N),2)>-1,ROUND(SUMIFS($J:$J,$A:$A,A2,$Y:$Y,""INCLUDE"")-SUMIF(FinalABC!$A:$A,A2,FinalABC!$N:$N),2)<1),K2,""MANUAL INPUT""))" .Range("AJ2").Formula = "=IF(OR($X2=""NON EXIST"",$Y2=""EXCLUDE""),""NON REPORTABLE"",ROUND(E2*SUM(AI2/100),2))" .Range("AK2").Formula = "=IF(OR($X2=""NON EXIST"",$Y2=""EXCLUDE""),""NON REPORTABLE"",SUMIF($A:$A,A2,$AJ:$AJ)-SUMIF(FinalABC!$A:$A,A2,FinalABC!$N:$N))" .Range("AL2").Formula = "=IF(OR($X2=""NON EXIST"",$Y2=""EXCLUDE""), ""NON REPORTABLE"", IFERROR(VLOOKUP($A2,'Mapping Pivots'!$A:$D,4,FALSE), IFERROR(VLOOKUP($AB2,'Mapping Pivots'!$F:$I,4,FALSE), ""MANUAL INPUT"")))" .Range("AN2").Formula = "=IF(OR($X2=""NON EXIST"",$Y2=""EXCLUDE""),""NON REPORTABLE"",IFERROR(VLOOKUP(A2&"" - ""&AM2,'Mapping Pivots'!$K:$M,2,FALSE),0))" .Range("AO2").Formula = "=IF(OR($X2=""NON EXIST"",$Y2=""EXCLUDE""),""NON REPORTABLE"",IF(AN2=0,0,F2/AN2))" .Range("AP2").Formula = "=IF(OR($X2=""NON EXIST"",$Y2=""EXCLUDE""),""NON REPORTABLE"",IF(COUNTIF($A$1:A2,A2)>1,""AGGREGATE"",SUMIF($A:$A,A2,$AO:$AO)-SUMIF(FinalABC!$A:$A,A2,FinalABC!$K:$K)))" .Range("AQ2").Formula = "=IF(OR($X2=""NON EXIST"",$Y2=""EXCLUDE""),""NON REPORTABLE"",T2&"" - ""& IFERROR(IF(VLOOKUP(R2,Wxxxx!B:Z,24,FALSE)=""YES"", ""VALID"", ""INVALID""),""INVALID"")&"" - "" & IFERROR(VLOOKUP(R2,Wxxxx!B:Z,25,FALSE),""N"") &"" - ""&K2)" .Range("AR2").Formula = "=IF(OR($X2=""NON EXIST"",$Y2=""EXCLUDE""),""NON REPORTABLE"",IFERROR(VLOOKUP(AQ2,References!$H$1:$K$45,2,FALSE),0))" .Range("AS2").Formula = "=IF(OR($X2=""NON EXIST"",$Y2=""EXCLUDE""),""NON REPORTABLE"",IFERROR(VLOOKUP(AQ2,References!$H$1:$K$45,3,FALSE),0))" .Range("AT2").Formula = "=IF(OR($X2=""NON EXIST"",$Y2=""EXCLUDE""),""NON REPORTABLE"",IFERROR(VLOOKUP(AQ2,References!$H$1:$K$45,4,FALSE),0))" .Range("AV2").Formula = "=IF(OR($X2=""NON EXIST"",$Y2=""EXCLUDE""),""NON REPORTABLE"",IFERROR(VLOOKUP(AD2&"" - ""&AF2,References!S:W,3,FALSE),0))" .Range("AW2").Formula = "=IF(OR($X2=""NON EXIST"",$Y2=""EXCLUDE""),""NON REPORTABLE"",IF(OR(AR2=""NO ADJUSTMENT REQUIRED"",K2=AU2),""NO ADJUSTMENT REQUIRED"",""ADJUST FROM ""&K2&""% TO ""&AU2&""% - BBH REPORTED ""&AH2&""%""))" .Range("AX2").Formula = "=IF(OR($X2=""NON EXIST"",$Y2=""EXCLUDE""),""NON REPORTABLE"",IF(R2=530572,""BPB&T IOM"",IF(T2=""IBGC"",""BPCI"",""BPB&T Jersey"")))" .Range("AY2").Formula = "=IF(WV2=""NO ADJUSTMENT REQUIRED"",""NO ADJUSTMENT REQUIRED"",IF(AW2=""NON REPORTABLE"",""NON REPORTABLE"",ROUND((F2*AU2%)-J2,2)))" .Range("BB2").Formula = "=IF(ISNA(VLOOKUP(U2,References!$AG:$AG,1,FALSE)),""NO ADJUSTMENT REQUIRED"",IF(AW2=""NO ADJUSTMENT REQUIRED"",""NO ADJUSTMENT REQUIRED"",IF(AW2=""NON REPORTABLE"",""NON REPORTABLE"",IFERROR(VLOOKUP(T2&"" - ""&AT2,References!$O$2:$Q$5,3,FALSE),0))))" .Range("BD2").Formula = "=IF(AW2=""NO ADJUSTMENT REQUIRED"",""NO ADJUSTMENT REQUIRED"",IF(AW2=""NON REPORTABLE"",""NON REPORTABLE"",IFERROR(VLOOKUP(T2& "" - "" &AU2,References!$O$2:$Q$5,2,FALSE),0)))" .Range("BE2").Formula = "=IF(AW2=""NO ADJUSTMENT REQUIRED"",""NO ADJUSTMENT REQUIRED"",IF(AW2=""NON REPORTABLE"",""NON REPORTABLE"",IF(BD2<>M2,""Yes"",""No"")))" .Range("BG2").Formula = "=IF(ISNA(VLOOKUP(R2&N2,HOLDINGS!A:A,1,FALSE)),""NO HOLDINGS"",""STILL HAS HOLDINGS"")" .Range("BH2").Formula = "=IFERROR(VLOOKUP(R2&N2,HOLDINGS!A:F,6,FALSE), ""NO HOLDINGS"")" .Range("BI2").Formula = "=IF(BH2=""NO HOLDINGS"",""NO HOLDINGS"",IFERROR(VLOOKUP(BH2,References!A:B,2,FALSE),0))" .Range("BJ2").Formula = "=IF(OR(BB2=""NO ADJUSTMENT REQUIRED"",Y2=""EXCLUDE""),""NO ADJUSTMENT REQUIRED"",IFERROR(VLOOKUP(LEFT(P2,6)&TEXT(H2,""#.00"")&R2,TRANSACTIONS!A:L,12,FALSE),0))" .Range("BK2").Formula = "=IF(OR(BB2=""NO ADJUSTMENT REQUIRED"",Y2=""EXCLUDE""),""NO ADJUSTMENT REQUIRED"",IFERROR(VLOOKUP(LEFT(P2,6)&TEXT(H2,""#.00"")&R2,TRANSACTIONS!A:M,13,FALSE),0))" .Range("BL2").Formula = "=IF(OR(BB2=""NO ADJUSTMENT REQUIRED"",Y2=""EXCLUDE""),""NO ADJUSTMENT REQUIRED"",IFERROR(VLOOKUP(LEFT(P2,6)&TEXT(H2,""#.00"")&R2,TRANSACTIONS!A:N,14,FALSE),0))" .Range("BM2").Formula = "=IF(ISNA(VLOOKUP(R2,QSHEET!A:A,1,FALSE)),""NOT ON QSHEET"", ""ON QSHEET"")" End With ' Resets formulae on FinalABC. With .Sheets("FinalABC") .Activate ' Update StatusBar. Application.StatusBar = "Resetting Formulae...on FinalABC" .Range("A2").Formula = "=D2&"" - ""&TEXT(E2,""MMM"")&"" ""&YEAR(E2)" .Range("B2").Formula = "=A2&"" - ""&ROUND(L2,0)" .Range("C2").Formula = "=A2&"" - ""&G2" .Range("E2").Formula = "=TEXT(MID(F2,FIND("" "",F2)+1,FIND("","",F2)-FIND("" "",F2)-1)&"" ""&LEFT(F2,FIND("" "",F2)-1)&"" ""&RIGHT(F2,4),""dd/mm/yyyy"")" .Range("K2").Formula = "=I2+J2" .Range("L2").Formula = "=K2*AE2" .Range("M2").Formula = "=L2-N2" .Range("N2").Formula = "=P2*AE2" .Range("P2").Formula = "=IF(R2="""",K2*S2/100,K2*R2/100)" .Range("Q2").Formula = "=IF(R2="""",S2*100,R2*100)" .Range("AI2").Formula = "=IF(ISNA(VLOOKUP(D2,'SHEETNAME1'!G:G,1,FALSE)),""NOT FOUND"",""FOUND"")" .Range("AJ2").Formula = "=D2=D1" .Range("AK2").Formula = "=IF(COUNTIF($A$1:A2,A2)>1,""AGGREGATE"",SUMIF($A:$A,A2,$L:$L)-SUMIF('SHEETNAME1'!$A:$A,A2,'SHEETNAME1'!$F:$F))" .Range("AL2").Formula = "=IF(A2=A1,AL1,IF(AND(AK2>-0.1,AK2<0.1),""MATCHED GROSS AMOUNT ISIN BY MONTH"",""GROSS AMOUNT NOT MATCHED ISIN BY MONTH""))" .Range("AM2").Formula = "=IF(COUNTIF($A$1:A2,A2)>1,""AGGREGATE"",SUMIF($A:$A,A2,$K:$K)-SUMIF('SHEETNAME1'!A:A,A2,'SHEETNAME1'!$AN:$AN))" .Range("AR2").Formula = "=IF(COUNTIF($A$1:$A2,$A2)>1,""AGGREGATE"",SUMIF($A:$A,$A2,$O:$O)-SUMIF(SHEETNAME1!$A:$A,$A2,SHEETNAME1!$J:$J))" .Range("AS2").Formula = "=IF(A2=A1,AS1,IF(AND(AR2>-0.1,AR2<0.1),""MATCHED TAX AMOUNT ISIN BY MONTH"",""TAX AMOUNT NOT MATCHED ISIN BY MONTH""))" .Range("AT2").Formula = "=IF(COUNTIF($A$1:$A2,$A2)>1,""AGGREGATE"",SUMIF($A:$A,$A2,$O:$O)-SUMIF(SHEETNAME1!$A:$A,$A2,SHEETNAME1!$I:$I))" End With ' Resets formulae on References. ' These are hard-coded for various rows as small in number. With .Sheets("References") .Activate ' Update StatusBar. Application.StatusBar = "Resetting Formulae...on References" .Range("O2").Formula = "=M2&"" - ""&N2" .Range("O3").Formula = "=M3&"" - ""&N3" .Range("O4").Formula = "=M4&"" - ""&N4" .Range("O5").Formula = "=M5&"" - ""&N5" .Range("S2").Formula = "=V2&"" - ""&W2" .Range("S3").Formula = "=V3&"" - ""&W3" .Range("S4").Formula = "=V4&"" - ""&W4" .Range("S5").Formula = "=V5&"" - ""&W5" .Range("S6").Formula = "=V6&"" - ""&W6" .Range("S7").Formula = "=V7&"" - ""&W7" .Range("S8").Formula = "=V8&"" - ""&W8" .Range("S9").Formula = "=V9&"" - ""&W9" .Range("S10").Formula = "=V10&"" - ""&W10" End With ' Resets formulae on QSHEET. With .Sheets("QSHEET") .Activate ' Update StatusBar. Application.StatusBar = "Resetting Formulae...on QSHEET" .Range("E2").Formula = "=VLOOKUP(A2,C:C,1,FALSE)" End With ' Resets formulae on "Wxxxx". With .Sheets("Wxxxx") .Activate ' Update StatusBar. Application.StatusBar = "Resetting Formulae...on Wxxxx" .Range("Y2").Formula = "=IF(AND(YEAR(T2)>=YEAR(NOW()), YEAR(T2)-YEAR(S2)<=3),IF(TRIM(C2)<>"""",IF(E2=TRUE,IF(G2=TRUE,IF(TRIM(K2)<>""All Other Countries"",IF(O2=TRUE,IF(P2=TRUE,IF(Q2=TRUE,IF(X2=FALSE,""YES"",""NO1""),""NO2""),""NO3""),""NO4""),""NO5""),""NO6""),""NO7""),""NO8""),""NO9"")" .Range("Z2").Formula = "=IF(Y2=""YES"",IFERROR(VLOOKUP(K2,References!AI:AJ,2,FALSE),30),30)" End With End With End Sub ' Refreshes all queries on all sheets. Sub M10040_Refresh_Queries() Dim cn As WorkbookConnection ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Refresh all queries?", vbYesNo) = vbNo Then Exit Sub End If ' First, ensure that the queries do not run in the background. ' The queries need to really complete before we continue with the next subroutines. For Each cn In ThisWorkbook.Connections If cn.Type = xlConnectionTypeODBC Then cn.ODBCConnection.BackgroundQuery = False End If If cn.Type = xlConnectionTypeOLEDB Then cn.OLEDBConnection.BackgroundQuery = False End If ' Update status message. Application.StatusBar = "Refreshing " & cn.name & "..." ' Refresh the query. cn.Refresh Next cn ' Call Sort_Queries Call M10050_Sort_Queries ' Clear all variables. Set cn = Nothing End Sub ' Sorts all queries on all sheets. ' Unfortunately, the SQL sort does not match how Excel sorts the data, and therefore these are resorted per Excel. Sub M10050_Sort_Queries() Dim lastrow_SHEETNAME1Auto As Long Dim lastrow_CUST As Long Dim lastrow_HOLDINGS As Long Dim lastrow_QSHEET As Long Dim lastrow_SECT As Long Dim lastrow_TRANSACTIONS As Long Dim lastrow_Wxxxx As Long ' Initialize global vars. Call Z00000_Init ' Ask user. ' If ctrl_ask_before_running_subroutine = True Then ' If MsgBox("Sort all queries?", vbYesNo) = vbNo Then Exit Sub ' End If ' Update StatusBar. Application.StatusBar = "Sorting Queries..." With Workbooks(wb_name) With .Sheets("SECT") ' Activates the sheet. .Activate ' Update StatusBar. Application.StatusBar = "Sorting Queries...on SECT" ' Determine the number of rows. lastrow_SECT = .Cells(Rows.Count, 1).End(xlUp).Row ' Do the sort. With .Sort '.AutoFilter With .SortFields .Clear .Add Key:=Range("A1:A" & lastrow_SECT), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal End With .SetRange Range("A1:B" & lastrow_SECT) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With ' Select A1. ScrollTo ActiveSheet.name, "A1" End With With .Sheets("TRANSACTIONS") ' Activates the sheet. .Activate ' Update StatusBar. Application.StatusBar = "Sorting Queries...on TRANSACTIONS" ' Determine the number of rows. lastrow_TRANSACTIONS = .Cells(Rows.Count, 1).End(xlUp).Row ' Do the sort. With .Sort '.AutoFilter With .SortFields .Clear .Add Key:=Range("A1:A" & lastrow_TRANSACTIONS), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal End With .SetRange Range("A1:N" & lastrow_TRANSACTIONS) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With ' Select A1. ScrollTo ActiveSheet.name, "A1" End With With .Sheets("HOLDINGS") ' Activates the sheet. .Activate ' Update StatusBar. Application.StatusBar = "Sorting Queries...on HOLDINGS" ' Determine the number of rows. lastrow_HOLDINGS = .Cells(Rows.Count, 1).End(xlUp).Row ' Do the sort. With .Sort '.AutoFilter With .SortFields .Clear .Add Key:=Range("A1:A" & lastrow_HOLDINGS), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal End With .SetRange Range("A1:Y" & lastrow_HOLDINGS) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With ' Select A1. ScrollTo ActiveSheet.name, "A1" End With With .Sheets("CUST") ' Activates the sheet. .Activate ' Update StatusBar. Application.StatusBar = "Sorting Queries...on CUST" ' Determine the number of rows. lastrow_CUST = .Cells(Rows.Count, 1).End(xlUp).Row ' Do the sort. With .Sort '.AutoFilter With .SortFields .Clear .Add Key:=Range("A1:A" & lastrow_CUST), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal End With .SetRange Range("A1:B" & lastrow_CUST) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With ' Select A1. ScrollTo ActiveSheet.name, "A1" End With With .Sheets("SHEETNAME1 - Auto") ' Activates the sheet. .Activate ' Update StatusBar. Application.StatusBar = "Sorting Queries...on SHEETNAME1 - Auto" ' Determine the number of rows. lastrow_SHEETNAME1Auto = .Cells(Rows.Count, 1).End(xlUp).Row ' Do the sort. With .Sort '.AutoFilter With .SortFields .Clear .Add Key:=Range("A1:A" & lastrow_SHEETNAME1Auto), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal End With .SetRange Range("A1:T" & lastrow_SHEETNAME1Auto) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With ' Select A1. ScrollTo ActiveSheet.name, "A1" End With With .Sheets("QSHEET") ' Activates the sheet. .Activate ' Update StatusBar. Application.StatusBar = "Sorting Queries...on QSHEET" ' Determine the number of rows. lastrow_QSHEET = .Cells(Rows.Count, 1).End(xlUp).Row ' Do the sort. With .Sort '.AutoFilter With .SortFields .Clear ' PETER-FIX 20191211 .Add Key:=Range("A1:A" & lastrow_CUST), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .Add Key:=Range("A1:A" & lastrow_QSHEET), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal End With ' PETER-FIX 20191211 .SetRange Range("A1:A" & lastrow_CUST) .SetRange Range("A1:A" & lastrow_QSHEET) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With ' Select A1. ScrollTo ActiveSheet.name, "A1" End With With .Sheets("Wxxxx") ' Activates the sheet. .Activate ' Update StatusBar. Application.StatusBar = "Sorting Queries...on Wxxxx" ' Determine the number of rows. lastrow_Wxxxx = .Cells(Rows.Count, 2).End(xlUp).Row ' Do the sort. With .Sort '.AutoFilter With .SortFields .Clear .Add Key:=Range("B1:B" & lastrow_Wxxxx), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal End With ' PETER-FIX 20191211. .SetRange Range("A1:Z" & lastrow_CUST) .SetRange Range("A1:Z" & lastrow_Wxxxx) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With ' Select A1. ScrollTo ActiveSheet.name, "A1" End With End With End Sub ' Imports the FinalABC file. ' Imports the FinalABC file. Sub M10100_Import_FinalABC() Dim fileToOpen As Variant Dim count_FinalABC As Double Dim count_InputFile As Double Dim lastrow_FinalABC As Long Dim lastrow_InputFile As Long Dim my_from_column As Variant Dim my_to_column As Variant Dim fileToOpen_name As String Dim FileParts() As String ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Import FinalABC?", vbYesNo) = vbNo Then Exit Sub End If ' Clear the FinalABC sheet. Call M10020_Clear_FinalABC ' Ask user for a FinalABC file to load. fileToOpen = Application.GetOpenFilename("Excel files (*.xls; *.xlsx; *.csv),*.xls; *.xlsx; *.csv", , "Select FinalABC file") If fileToOpen = False Then MsgBox "No BBH file selected. No data copied across to the FinalABC sheet." Exit Sub End If FileParts() = Split(fileToOpen, Application.PathSeparator) fileToOpen_name = FileParts(UBound(FileParts)) ' Update StatusBar. Application.StatusBar = "Importing FinalABC file..." & fileToOpen_name ' Start of copying columns across. With Workbooks.Open(fileToOpen) With .Sheets(1) ' Control to check that the FinalABC file is in the usual format. If .Range("A2") Like "???????" Then Else If ctrl_close_erroneous_files = True Then ' Close the file. Application.DisplayAlerts = False Workbooks(fileToOpen_name).Close Application.DisplayAlerts = True End If MsgBox "The FinalABC file is not in the usual format, it may have been change since the code was written, please follow the procedure to manually copy the columns across." Exit Sub End If ' Control to check that the FinalABC file is in the usual format. If .Range("I2") Like "????" Then Else If ctrl_close_erroneous_files = True Then ' Close the file. Application.DisplayAlerts = False Workbooks(fileToOpen_name).Close Application.DisplayAlerts = True End If MsgBox "The FinalABC file is not in the usual format, it may have been change since the code was written, please follow the procedure to manually copy the columns across" Exit Sub End If ' Control to check that the FinalABC file is in the usual format. If WorksheetFunction.CountA(.Range("A1:X1")) = 24 Then Else If ctrl_close_erroneous_files = True Then ' Close the file. Application.DisplayAlerts = False Workbooks(fileToOpen_name).Close Application.DisplayAlerts = True End If MsgBox "The FinalABC file is not in the usual format, it may have been change since the code was written, please follow the procedure to manually copy the columns across" Exit Sub End If ' Determine how many rows in the input file. lastrow_InputFile = .Cells(Rows.Count, 1).End(xlUp).Row ' Copy all columns from BBH file into master sheet where column names match. For Each my_from_column In .Range("A1:AD1") ' Range is all columns in BBH file. For Each my_to_column In Workbooks(wb_name).Sheets("FinalABC").Range("A1:AH1") ' AH is last column containing data from BBH file. If my_from_column = my_to_column Then .Range(Cells(2, my_from_column.Column), Cells(lastrow_InputFile + 1, my_from_column.Column).End(xlUp)).Copy Workbooks(wb_name).Sheets("FinalABC").Cells(2, my_to_column.Column) Next my_to_column Next my_from_column ' Counts the number of cells from the input file that should have been copied across. count_InputFile = WorksheetFunction.CountA(.Range("A2:V" & lastrow_InputFile)) End With ' Close the file. Application.DisplayAlerts = False .Close Application.DisplayAlerts = True End With ' Counts the number of cells in the FinalABC sheet that have been copied across. With Workbooks(wb_name) ' Activate the workbook. .Activate With .Sheets("FinalABC") ' Activate the sheet. .Activate ' Get how many rows of data have been loaded into the sheet. lastrow_FinalABC = .Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_FinalABC < 3 Then lastrow_FinalABC = 3 End If ' Count how much data has been loaded into the FinalABC sheet. count_FinalABC = WorksheetFunction.CountA( _ .Range("D2:D" & lastrow_FinalABC), _ .Range("F2:I" & lastrow_FinalABC), _ .Range("O2:O" & lastrow_FinalABC), _ .Range("S2:AH" & lastrow_FinalABC)) ' Select A1. ScrollTo ActiveSheet.name, "A1" End With End With ' Control to ensure that the number of cells copied across matches those in the originating file. If count_FinalABC <> count_InputFile Then Message "The number of cells copied from the FinalABC file does not equal the number of cells copied to the 1042 rec. Please manually copy them across." Exit Sub End If ' Clear all objects. Set my_from_column = Nothing Set my_to_column = Nothing End Sub ' Copy initial formulae down on the FinalABC sheet. ' Just enough data to allow the sheet to be later sorted and for the Mapping Pivots to be created. Sub M10110_Copy_Pre_FinalABC_Formulae_Down() Dim mycell As Variant Dim lastrow_FinalABC As Long Dim Pmt_Curr As Variant Dim FX_Rate As Variant ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Copy pre FinalABC formulae down?", vbYesNo) = vbNo Then Exit Sub End If ' Update StatusBar. Application.StatusBar = "Copy pre-FinalABC formulae down..." With Workbooks(wb_name) With .Sheets("FinalABC") ' Activate the FinalABC sheet. .Activate ' Get how many rows of data have been loaded into the sheet. lastrow_FinalABC = .Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_FinalABC < 3 Then lastrow_FinalABC = 3 End If ' Ensure that FX_Rate has a default value. 'For Each mycell In Workbooks(my1042Rec).Sheets("FinalABC").Range("AE2", Range("AE65536").End(xlUp)) For Each mycell In .Range("AE2:AE" & lastrow_FinalABC) If Not mycell Like "*[0-9]*" Then mycell.Formula = 1 Next mycell ' Copy using autofill. .Range("A2:A2").AutoFill Destination:=.Range("A2:A" & lastrow_FinalABC) .Range("B2:C2").AutoFill Destination:=.Range("B2:C" & lastrow_FinalABC) .Range("E2").AutoFill Destination:=.Range("E2:E" & lastrow_FinalABC) .Range("K2:L2").AutoFill Destination:=.Range("K2:L" & lastrow_FinalABC) ' Copy using a resize. Some say much quicker than alternative solutions, but not proven. ' Destination is lastrow -1 as need to exclude header row. 'Dim rngSource As Range 'Dim rngTarget As Range ' Set rngSource = .Range("A2:A2") ' Set rngTarget = Range("A2:A2") ' rngTarget.Resize(lastrow_FinalABC - 1, rngSource.Columns.Count).Formula = rngSource.Formula ' Ensure that Payment Currency is set to something. Default to USD for unknowns. For Each Pmt_Curr In .Range("G2:G" & lastrow_FinalABC) If RTrim(LTrim(Pmt_Curr)) = "" Then Pmt_Curr.Value = "USD" Next Pmt_Curr ' Ensure that the FX Rate is set to a valid number. Default to 1 for unknowns. For Each FX_Rate In .Range("AE2:AE" & lastrow_FinalABC) If IsNumeric(FX_Rate) = False Then FX_Rate.Value = 1 Next FX_Rate ' Calculations. .Range("E2:E" & lastrow_FinalABC).Calculate .Range("A2:A" & lastrow_FinalABC).Calculate .Range("K2:L" & lastrow_FinalABC).Calculate .Range("B2:C" & lastrow_FinalABC).Calculate ' Now copy and paste formula ranges as values to speed up the file processing. .Range("A3:A" & lastrow_FinalABC) = .Range("A3:A" & lastrow_FinalABC).Value .Range("B3:C" & lastrow_FinalABC) = .Range("B3:C" & lastrow_FinalABC).Value .Range("E3:E" & lastrow_FinalABC) = .Range("E3:E" & lastrow_FinalABC).Value .Range("K3:L" & lastrow_FinalABC) = .Range("K3:L" & lastrow_FinalABC).Value ' Select A1. ScrollTo ActiveSheet.name, "A1" End With End With ' Clear all objects. Set mycell = Nothing Set Pmt_Curr = Nothing Set FX_Rate = Nothing End Sub ' Sort FinalABC on column A in ascending order. Sub M10120_Sort_FinalABC_column_A() Dim lastrow_FinalABC As Long ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Sort FinalABC column A?", vbYesNo) = vbNo Then Exit Sub End If ' Update StatusBar. Application.StatusBar = "Sorting FinalABC...Column A" With Workbooks(wb_name) With .Sheets("FinalABC") ' Activate the sheet. .Activate ' Get how many rows of data have been loaded into the sheet. lastrow_FinalABC = .Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_FinalABC < 3 Then lastrow_FinalABC = 3 End If On Error GoTo Whoa ' Do the sort. With .Sort .SortFields.Clear ' .SortFields.Add Key:=Range("A1:A" & lastrow_FinalABC), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _ ' "Open,Closed", DataOption:=xlSortNormal .SortFields.Add Key:=Range("A1:A1" & lastrow_FinalABC), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SetRange Range("A1:AT" & lastrow_FinalABC) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End With End With Exit Sub Whoa: MsgBox "Error " & Err.Number & " " & Err.Description, vbOKOnly End Sub ' Refresh the Mapping Pivots. ' These only depend on data on the FinalABC sheet. Sub M10200_Refresh_Mapping_Pivots() Dim pt As PivotTable Dim pc As PivotCache Dim lastrow_FinalABC As Long Dim FinalABC_range As Range ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Refresh Mapping Pivot Tables?", vbYesNo) = vbNo Then Exit Sub End If ' Update StatusBar. Application.StatusBar = "Refreshing Mapping Pivots..." With Workbooks(wb_name) ' Get how many rows of data have been loaded into the sheet. lastrow_FinalABC = .Sheets("FinalABC").Cells(Rows.Count, 4).End(xlUp).Row Set FinalABC_range = Range("FinalABC!A1:AT" & lastrow_FinalABC) With .Sheets("Mapping Pivots") ' Activate the sheet. .Activate ' Refresh all the pivot tables on the Mapping Pivots sheet. For Each pt In ActiveWorkbook.ActiveSheet.PivotTables ' Update StatusBar. Application.StatusBar = "Refreshing MappingPivot..." & pt.name Set pc = ActiveWorkbook.PivotCaches.Create(xlDatabase, FinalABC_range) pt.ChangePivotCache pc pt.RefreshTable pt.Update Next ' Select A1. ScrollTo ActiveSheet.name, "A1" End With End With ' Clear all objects. Set pt = Nothing Set pc = Nothing Set FinalABC_range = Nothing End Sub ' Import data into the SHEETNAME1 sheet from the "SHEETNAME1 - Auto" sheet instead of from a file. ' The "SHEETNAME1 - Auto" sheet is populated from a query against G3. Sub M10300_Import_SHEETNAME1_from_Auto() Dim SHEETNAME1 As String Dim count_SHEETNAME1_Auto As Double Dim count_SHEETNAME1 As Double Dim lastrow_SHEETNAME1 As Long Dim lastrow_SHEETNAME1_Auto As Long Dim i As Long Dim txt As String ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Import SHEETNAME1 Auto?", vbYesNo) = vbNo Then Exit Sub End If ' Update StatusBar. Application.StatusBar = "Import SHEETNAME1 from Auto..." With Workbooks(wb_name) ' Clear the existing SHEETNAME1 sheet. With .Sheets("SHEETNAME1") ' Activate the SHEETNAME1 sheet. .Activate ' Get how many rows of data have been loaded into the sheet. lastrow_SHEETNAME1 = .Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_SHEETNAME1 < 3 Then lastrow_SHEETNAME1 = 3 End If ' Clear entire sheet, except for row 2 which contains formulae. With .Range("A3:BO" & lastrow_SHEETNAME1) .ClearContents End With ' Clear fields loaded from SHEETNAME1 file. .Range("C2:E" & lastrow_SHEETNAME1).ClearContents .Range("G2:G" & lastrow_SHEETNAME1).ClearContents .Range("I2:I" & lastrow_SHEETNAME1).ClearContents .Range("N2:S" & lastrow_SHEETNAME1).ClearContents .Range("U2:U" & lastrow_SHEETNAME1).ClearContents ' Clear any double lines. These are used to flag where the ISIN changes. .Range("A1:BO" & lastrow_SHEETNAME1).Borders.LineStyle = xlNone ' Control to confirm there is currently no data in the blue columns in the SHEETNAME1 sheet. If WorksheetFunction.CountA( _ .Range("C2:E" & lastrow_SHEETNAME1), _ .Range("G2:G" & lastrow_SHEETNAME1), _ .Range("I2:I" & lastrow_SHEETNAME1), _ .Range("N2:S" & lastrow_SHEETNAME1), _ .Range("U2:U" & lastrow_SHEETNAME1)) > 0 Then MsgBox "There is data still present in the blue columns in the SHEETNAME1 sheet, these should be blank. Ensure they are empty before running this process" Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True Application.ScreenUpdating = True Exit Sub End If End With With .Sheets("SHEETNAME1 - Auto") ' Activate the sheet. .Activate '.Range("A1").Select ScrollTo ActiveSheet.name, "A1" ' Update StatusBar. Application.StatusBar = "Refreshing the ""SHEETNAME1 - Auto"" query..." ' Refresh the queries. Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False ' Control to check that the SHEETNAME1 file is in the usual format. If .Range("A2") Like "???" And .Range("T2") Like "???" And .Range("N2") Like "########" Then Else MsgBox "The 'SHEETNAME1 - Auto' sheet is not in the usual format, it may have been changed since the code was written, please follow the procedure to manually copy the columns across" Exit Sub End If ' Update StatusBar. Application.StatusBar = "Copying data from ""SHEETNAME1 - Auto"" to SHEETNAME1..." ' Copy data from "SHEETNAME1 - Auto" to SHEETNAME1 my way. lastrow_SHEETNAME1_Auto = .Cells(Rows.Count, 4).End(xlUp).Row .Range("A2:A" & lastrow_SHEETNAME1_Auto).Copy Sheets("SHEETNAME1").Range("S2") .Range("C2:C" & lastrow_SHEETNAME1_Auto).Copy Sheets("SHEETNAME1").Range("R2") .Range("D2:D" & lastrow_SHEETNAME1_Auto).Copy Sheets("SHEETNAME1").Range("S2") .Range("F2:F" & lastrow_SHEETNAME1_Auto).Copy Sheets("SHEETNAME1").Range("E2") .Range("G2:G" & lastrow_SHEETNAME1_Auto).Copy Sheets("SHEETNAME1").Range("N2") .Range("J2:J" & lastrow_SHEETNAME1_Auto).Copy Sheets("SHEETNAME1").Range("C2") .Range("K2:K" & lastrow_SHEETNAME1_Auto).Copy Sheets("SHEETNAME1").Range("P2") .Range("L2:L" & lastrow_SHEETNAME1_Auto).Copy Sheets("SHEETNAME1").Range("Q2") .Range("P2:P" & lastrow_SHEETNAME1_Auto).Copy Sheets("SHEETNAME1").Range("I2") .Range("Q2:Q" & lastrow_SHEETNAME1_Auto).Copy Sheets("SHEETNAME1").Range("G2") .Range("T2:T" & lastrow_SHEETNAME1_Auto).Copy Sheets("SHEETNAME1").Range("D2") ' Counts the number of cells in the SHEETNAME1 file that should have been copied across. count_SHEETNAME1_Auto = WorksheetFunction.CountA( _ .Range("A2:A" & lastrow_SHEETNAME1_Auto), _ .Range("C2:C" & lastrow_SHEETNAME1_Auto), _ .Range("D2:D" & lastrow_SHEETNAME1_Auto), _ .Range("F2:F" & lastrow_SHEETNAME1_Auto), _ .Range("G2:G" & lastrow_SHEETNAME1_Auto), _ .Range("H2:H" & lastrow_SHEETNAME1_Auto), _ .Range("J2:J" & lastrow_SHEETNAME1_Auto), _ .Range("K2:K" & lastrow_SHEETNAME1_Auto), _ .Range("L2:L" & lastrow_SHEETNAME1_Auto), _ .Range("P2:P" & lastrow_SHEETNAME1_Auto), _ .Range("Q2:Q" & lastrow_SHEETNAME1_Auto), _ .Range("T2:T" & lastrow_SHEETNAME1_Auto)) End With ' Tidy up some columns in the SHEETNAME1 sheet. With .Sheets("SHEETNAME1") ' Activate the sheet. .Activate ' Get how many rows of data have been loaded into the sheet. lastrow_SHEETNAME1 = .Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_SHEETNAME1 < 3 Then lastrow_SHEETNAME1 = 3 End If ' Update StatusBar. Application.StatusBar = "Fixing SEDOLs..." 'Set the SEDOL range format to text. .Range("N2:N" & lastrow_SHEETNAME1).NumberFormat = "@" ' Adds 0's to the front of the sedol number. Dim x For i = 2 To lastrow_SHEETNAME1 txt = .Range("N" & i).Value If Len(txt) < 7 Then For x = 1 To (7 - Len(txt)) txt = "0" & txt Next x End If If IsNumeric(txt) Then txt = "'" & txt End If .Range("N" & i) = txt Next i ' In the SHEETNAME1 file, the sedol name is spread out over two columsn, so we can't do a straight copy and paste ' therefore we must put a formula in the SHEETNAME1 sheet to concatenate the two columns. .Range("O2").Formula = "='SHEETNAME1 - Auto'!H2&'SHEETNAME1 - Auto'!I2" .Range("O2:O2").AutoFill Destination:=Range("O2:O" & lastrow_SHEETNAME1) ' Update StatusBar. Application.StatusBar = "Fixing Pay Dates..." ' Convert the pay date using a formula. ' In order to convert the pay date it is neccessary to use a formula that copies the data from the SHEETNAME1 file instead of copy/pasting it. .Range("C2").Formula = "=if('SHEETNAME1 - Auto'!J2>9999999,DATE(RIGHT('SHEETNAME1 - Auto'!J2,4),MID('SHEETNAME1 - Auto'!J2,3,2),LEFT('SHEETNAME1 - Auto'!J2,2)),DATE(RIGHT('SHEETNAME1 - Auto'!J2,4),MID('SHEETNAME1 - Auto'!J2,2,2),LEFT('SHEETNAME1 - Auto'!J2,1)))" ' Change format of date. .Range("C2:C2").AutoFill Destination:=.Range("C2:C" & lastrow_SHEETNAME1) .Range("C2:C" & lastrow_SHEETNAME1).NumberFormat = "yyyymmdd" .Range("C2:C" & lastrow_SHEETNAME1).Calculate ' Change formulae to values. .Range("C3:C" & lastrow_SHEETNAME1) = .Range("C3:C" & lastrow_SHEETNAME1).Value ' Counts the number of cells in the SHEETNAME1 that have been copied across. count_SHEETNAME1 = WorksheetFunction.CountA( _ .Range("C2:E" & lastrow_SHEETNAME1), _ .Range("G2:G" & lastrow_SHEETNAME1), _ .Range("I2:I" & lastrow_SHEETNAME1), _ .Range("N2:S" & lastrow_SHEETNAME1), _ .Range("U2:U" & lastrow_SHEETNAME1)) ' Control to ensure that the number of cells copied across matches those in the originating file. If count_SHEETNAME1 <> count_SHEETNAME1_Auto Then MsgBox "The number of cells copied from the SHEETNAME1 file does not equal the number of cells copied to the 1042 rec. Please manually copy them across." '.Range("C2:E" & lastrow_SHEETNAME1).ClearContents '.Range("G2:G" & lastrow_SHEETNAME1).ClearContents '.Range("I2:I" & lastrow_SHEETNAME1).ClearContents '.Range("K2:K" & lastrow_SHEETNAME1).ClearContents '.Range("M2:R" & lastrow_SHEETNAME1).ClearContents '.Range("T2:T" & lastrow_SHEETNAME1).ClearContents Exit Sub End If ' Select A1. ScrollTo ActiveSheet.name, "A1" End With With .Sheets("FinalABC") ' Activate the FinalABC sheet. .Activate ' Resets formulae on FinalABC to point to "SHEETNAME1" instead of "SHEETNAME1". .Range("AI2").Formula = "=IF(ISNA(VLOOKUP(D2,'SHEETNAME1'!G:G,1,FALSE)),""NOT FOUND"",""FOUND"")" .Range("AK2").Formula = "=IF(COUNTIF($A$1:A2,A2)>1,""AGGREGATE"",SUMIF($A:$A,A2,$L:$L)-SUMIF('SHEETNAME1'!$A:$A,A2,'SHEETNAME1'!$F:$F))" .Range("AM2").Formula = "=IF(COUNTIF($A$1:A2,A2)>1,""AGGREGATE"",SUMIF($A:$A,A2,$K:$K)-SUMIF('SHEETNAME1'!A:A,A2,'SHEETNAME1'!$AN:$AN))" .Range("AR2").Formula = "=IF(COUNTIF($A$1:A2,A2)>1,""AGGREGATE"",SUMIF($A:$A,A2,$P:$P)-SUMIF('SHEETNAME1'!$A:$A,A2,'SHEETNAME1'!$J:$J))" .Range("AT2").Formula = "=IF(COUNTIF($A$1:A2,A2)>1,""AGGREGATE"",SUMIF($A:$A,A2,$O:$O)-SUMIF('SHEETNAME1'!A:A,A2,'SHEETNAME1'!$I:$I))" End With End With End Sub ' Import data into the SHEETNAME1 sheet from a file. ' Filename must be in the format SHEETNAME1CCYYMMDD.csv. ' If not MMDD available then use 9999 in their place. Sub M10300_Import_SHEETNAME1() Dim fileToOpen As Variant Dim count_SHEETNAME1 As Double Dim count_InputFile As Double Dim fileToOpen_name As String Dim FileParts() As String Dim lastrow_SHEETNAME1 As Long Dim lastrow_FinalABC As Long Dim lastrow_InputFile As Long Dim Include_Exclude As Variant Dim i As Long Dim txt As String ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Import SHEETNAME1?", vbYesNo) = vbNo Then Exit Sub End If ' Clear the SHEETNAME1 sheet. Call M10010_Clear_SHEETNAME1 ' Update StatusBar. Application.StatusBar = "Importing SHEETNAME1 file..." ' Prompt for a file. fileToOpen = Application.GetOpenFilename("Excel files (*.xls; *.xlsx; *.csv),*.xls; *.xlsx; *.csv", , "Select SHEETNAME1 file") If fileToOpen = False Then MsgBox "No BBH file selected. No data copied across to the FinalABC sheet." Exit Sub End If FileParts() = Split(fileToOpen, Application.PathSeparator) fileToOpen_name = FileParts(UBound(FileParts)) ' Update StatusBar. Application.StatusBar = "Importing SHEETNAME1 file..." & fileToOpen_name ' Start of copying columns across. With Workbooks.Open(fileToOpen) With .Sheets(1) ' Control to check that the SHEETNAME1 file is in the usual format. If .Range("A1") Like "???" And .Range("T1") Like "???" And .Range("N1") Like "########" Then Else MsgBox "The SHEETNAME1 file is not in the usual format, it may have been change since the code was written, please follow the procedure to manually copy the columns across." If ctrl_close_erroneous_files = True Then Application.DisplayAlerts = False Workbooks(fileToOpen_name).Close Application.DisplayAlerts = True End If Exit Sub End If ' Determine how many rows in the input file. lastrow_InputFile = .Cells(Rows.Count, 1).End(xlUp).Row End With ' Copy data to the SHEETNAME1 sheet. With .Sheets(1) ' Copy data from the Input file to the SHEETNAME1 sheet. .Range("A1:A" & lastrow_InputFile).Copy Workbooks(wb_name).Sheets("SHEETNAME1").Range("U2") .Range("C1:C" & lastrow_InputFile).Copy Workbooks(wb_name).Sheets("SHEETNAME1").Range("R2") .Range("D1:D" & lastrow_InputFile).Copy Workbooks(wb_name).Sheets("SHEETNAME1").Range("S2") .Range("F1:F" & lastrow_InputFile).Copy Workbooks(wb_name).Sheets("SHEETNAME1").Range("E2") .Range("G1:G" & lastrow_InputFile).Copy Workbooks(wb_name).Sheets("SHEETNAME1").Range("N2") ' In the SHEETNAME1 file, the sedol name is spread out over two columsn, so we can't do a straight copy and paste ' therefore we must put a formula in the SHEETNAME1 sheet to concatenate the two columns. Workbooks(wb_name).Sheets("SHEETNAME1").Range("O2").Formula = "=" & fileToOpen_name & "!H1&" & """; ""&" & fileToOpen_name & "!I1" ' In order to convert the pay date it is neccessary to use a formula that copies the data from the SHEETNAME1 file instead of copy/pasting it. Workbooks(wb_name).Sheets("SHEETNAME1").Range("C2").Formula = "=if(" & fileToOpen_name & "!J1>9999999,DATE(RIGHT(" & fileToOpen_name & "!J1,4),MID(" & fileToOpen_name & "!J1,3,2),LEFT(" & fileToOpen_name & "!J1,2)),DATE(RIGHT(" & fileToOpen_name & "!J1,4),MID(" & fileToOpen_name & "!J1,2,2),LEFT(" & fileToOpen_name & "!J1,1)))" ' Copy data from the Input file to the SHEETNAME1 sheet. .Range("K1:K" & lastrow_InputFile).Copy Workbooks(wb_name).Sheets("SHEETNAME1").Range("P2") .Range("L1:L" & lastrow_InputFile).Copy Workbooks(wb_name).Sheets("SHEETNAME1").Range("Q2") .Range("P1:P" & lastrow_InputFile).Copy Workbooks(wb_name).Sheets("SHEETNAME1").Range("I2") .Range("Q1:Q" & lastrow_InputFile).Copy Workbooks(wb_name).Sheets("SHEETNAME1").Range("G2") .Range("T1:T" & lastrow_InputFile).Copy Workbooks(wb_name).Sheets("SHEETNAME1").Range("D2") ' Counts the number of cells in the SHEETNAME1 file that should have been copied across. count_InputFile = WorksheetFunction.CountA( _ .Range("A1:A" & lastrow_InputFile), _ .Range("C1:C" & lastrow_InputFile), _ .Range("D1:D" & lastrow_InputFile), _ .Range("F1:F" & lastrow_InputFile), _ .Range("G1:G" & lastrow_InputFile), _ .Range("H1:H" & lastrow_InputFile), _ .Range("J1:J" & lastrow_InputFile), _ .Range("K1:K" & lastrow_InputFile), _ .Range("L1:L" & lastrow_InputFile), _ .Range("P1:P" & lastrow_InputFile), _ .Range("Q1:Q" & lastrow_InputFile), _ .Range("T1:T" & lastrow_InputFile)) End With End With With Workbooks(wb_name) With .Sheets("SHEETNAME1") ' Activate the SHEETNAME1 sheet. .Activate ' Get how many rows of data have been loaded into the sheet. lastrow_SHEETNAME1 = .Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_SHEETNAME1 < 3 Then lastrow_SHEETNAME1 = 3 End If ' Update StatusBar. Application.StatusBar = "Fixing SEDOLs..." 'Set the SEDOL range format to text. .Range("N2:N" & lastrow_SHEETNAME1).NumberFormat = "@" ' Adds 0's to the front of the sedol number. Dim x For i = 2 To lastrow_SHEETNAME1 txt = .Range("N" & i).Value If Len(txt) < 7 Then For x = 1 To (7 - Len(txt)) txt = "0" & txt Next x End If If IsNumeric(txt) Then txt = "'" & txt End If .Range("N" & i) = txt Next i ' Copy and paste SEDOL as values to allow vlookups to work correctly. ' Certain SEDOLs are only numbers and numbers don't work in vlookups to strings. .Range("N2:N" & lastrow_SHEETNAME1) = .Range("N2:N" & lastrow_SHEETNAME1).Value ' In the SHEETNAME1 file, the sedol name is spread out over two columsn, so we can't do a straight copy and paste ' therefore we must put a formula in the SHEETNAME1 sheet to concatenate the two columns. .Range("O2:O2").AutoFill Destination:=.Range("O2:O" & lastrow_SHEETNAME1) .Range("O2:O" & lastrow_SHEETNAME1).Calculate .Range("O2:O" & lastrow_SHEETNAME1) = .Range("O2:O" & lastrow_SHEETNAME1).Value ' Update StatusBar. Application.StatusBar = "Fixing Pay Dates..." ' In order to convert the pay date it is neccessary to use a formula that copies the data from the SHEETNAME1 file instead of copy/pasting it. .Range("C2:C2").AutoFill Destination:=.Range("C2:C" & lastrow_SHEETNAME1) .Range("C2:C" & lastrow_SHEETNAME1).NumberFormat = "yyyymmdd" .Range("C2:C" & lastrow_SHEETNAME1).Calculate .Range("C2:C" & lastrow_SHEETNAME1) = .Range("C2:C" & lastrow_SHEETNAME1).Value ' Copy "Include / Exclude" column value down. Default to setting this to INCLUDE. For Each Include_Exclude In .Range("Y2:Y" & lastrow_SHEETNAME1) If RTrim(LTrim(Include_Exclude)) = "" Then Include_Exclude.Value = "INCLUDE" Next Include_Exclude ' Counts the number of cells in the SHEETNAME1 sheet that have been copied across. count_SHEETNAME1 = WorksheetFunction.CountA( _ .Range("C2:C" & lastrow_SHEETNAME1), _ .Range("D2:D" & lastrow_SHEETNAME1), _ .Range("E2:E" & lastrow_SHEETNAME1), _ .Range("G2:G" & lastrow_SHEETNAME1), _ .Range("I2:I" & lastrow_SHEETNAME1), _ .Range("N2:N" & lastrow_SHEETNAME1), _ .Range("O2:O" & lastrow_SHEETNAME1), _ .Range("P2:P" & lastrow_SHEETNAME1), _ .Range("Q2:Q" & lastrow_SHEETNAME1), _ .Range("S2:S" & lastrow_SHEETNAME1), _ .Range("R2:R" & lastrow_SHEETNAME1), _ .Range("U2:U" & lastrow_SHEETNAME1)) ' Select A1. ScrollTo ActiveSheet.name, "A1" End With With .Sheets("FinalABC") ' Activate the FinalABC sheet. .Activate ' Get how many rows of data have been loaded into the sheet. lastrow_FinalABC = .Cells(Rows.Count, 5).End(xlUp).Row ' Resets formulae on FinalABC to point to "SHEETNAME1" instead of "SHEETNAME1 - Auto". .Range("AI2").Formula = "=IF(ISNA(VLOOKUP(D2,'SHEETNAME1'!$G$1:$G$" & lastrow_SHEETNAME1 & ",1,FALSE)),""NOT FOUND"",""FOUND"")" .Range("AK2").Formula = "=IF(COUNTIF($A$1:$A2,A2)>1,""AGGREGATE"",SUMIF($A$1:$A$" & lastrow_FinalABC & ",A2,$L$1:$L$" & lastrow_FinalABC & ")-SUMIF('SHEETNAME1'!$A$1:$A$" & lastrow_SHEETNAME1 & ",A2,'SHEETNAME1'!$F$1:$F$" & lastrow_SHEETNAME1 & "))" .Range("AM2").Formula = "=IF(COUNTIF($A$1:$A2,A2)>1,""AGGREGATE"",SUMIF($A$1:$A$" & lastrow_FinalABC & ",A2,$K$1:$K$" & lastrow_FinalABC & ")-SUMIF('SHEETNAME1'!$A$1:$A$" & lastrow_SHEETNAME1 & ",A2,'SHEETNAME1'!$AO$1:$AO$" & lastrow_SHEETNAME1 & "))" '.Range("AP2").Formula = "=IF(COUNTIF($A$1:A2,A2)>1,""AGGREGATE"",SUMIF($A:$A,A2,$O:$O)-SUMIF('SHEETNAME1'!$A:$A,A2,'SHEETNAME1'!$J:$J))" .Range("AR2").Formula = "=IF(COUNTIF($A$1:$A2,A2)>1,""AGGREGATE"",SUMIF($A$1:$A$" & lastrow_FinalABC & ",A2,$P$1:$P$" & lastrow_FinalABC & ")-SUMIF('SHEETNAME1'!$A$1:$A$" & lastrow_SHEETNAME1 & ",A2,'SHEETNAME1'!$J$1:$J$" & lastrow_SHEETNAME1 & "))" '.Range("AR2").Formula = "=IF(COUNTIF($A$1:A2,A2)>1,""AGGREGATE"",SUMIF($A:$A,A2,$O:$O)-SUMIF('SHEETNAME1'!A:A,A2,'SHEETNAME1'!$I:$I))" .Range("AT2").Formula = "=IF(COUNTIF($A$1:$A2,A2)>1,""AGGREGATE"",SUMIF($A$1:$A$" & lastrow_FinalABC & ",A2,$O$1:$O$" & lastrow_FinalABC & ")-SUMIF('SHEETNAME1'!$A$1:$A$" & lastrow_SHEETNAME1 & ",A2,'SHEETNAME1'!$I$1:$I$" & lastrow_SHEETNAME1 & "))" End With End With ' Control to ensure that the number of cells copied across matches those in the originating file. If count_SHEETNAME1 <> count_InputFile Then MsgBox "The number of cells copied from the Input File does not equal the number of cells copied to the SHEETNAME1 sheet. Please manually copy them across." 'Workbooks(my1042Rec).Sheets("SHEETNAME1").Range("C2", Range("E65536").End(xlUp)).ClearContents 'Workbooks(my1042Rec).Sheets("SHEETNAME1").Range("G2", Range("G65536").End(xlUp)).ClearContents 'Workbooks(my1042Rec).Sheets("SHEETNAME1").Range("I2", Range("I65536").End(xlUp)).ClearContents 'Workbooks(my1042Rec).Sheets("SHEETNAME1").Range("K2", Range("K65536").End(xlUp)).ClearContents 'Workbooks(my1042Rec).Sheets("SHEETNAME1").Range("M2", Range("R65536").End(xlUp)).ClearContents 'Workbooks(my1042Rec).Sheets("SHEETNAME1").Range("T2", Range("T65536").End(xlUp)).ClearContents ' Close the SHEETNAME1 file. If ctrl_close_erroneous_files = True Then Application.DisplayAlerts = False Workbooks(fileToOpen_name).Close Application.DisplayAlerts = True End If Exit Sub End If ' Close the SHEETNAME1 file. Application.DisplayAlerts = False Workbooks(fileToOpen_name).Close Application.DisplayAlerts = True ' Clear all objects. Set Include_Exclude = Nothing End Sub ' Updates the formulae on the FinalABC sheet to only reference the specific number of rows actually loaded into the ' FinalABC sheet instead of something like A:A which would reference over 1 million rows and therefore may slow down ' calculations etc. Sub M10400_Update_FinalABC_Formulae() Dim lastrow_SHEETNAME1 As Long Dim lastrow_FinalABC As Long ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Update FinalABC formulae?", vbYesNo) = vbNo Then Exit Sub End If ' Update StatusBar. Application.StatusBar = "Updating FinalABC Formulae..." With Workbooks(wb_name) With .Sheets("FinalABC") ' Activate the sheet. .Activate ' Get how many rows of data have been loaded into the sheet. lastrow_SHEETNAME1 = Sheets("SHEETNAME1").Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_SHEETNAME1 < 3 Then lastrow_SHEETNAME1 = 3 End If ' Get how many rows of data have been loaded into the sheet. lastrow_FinalABC = .Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_FinalABC < 3 Then lastrow_FinalABC = 3 End If ' Resets formulae on FinalABC. .Range("A2").Formula = "=D2&"" - ""&TEXT(E2,""MMM"")&"" ""&YEAR(E2)" .Range("B2").Formula = "=A2&"" - ""&ROUND(L2,0)" .Range("C2").Formula = "=A2&"" - ""&G2" .Range("E2").Formula = "=TEXT(MID(F2,FIND("" "",F2)+1,FIND("","",F2)-FIND("" "",F2)-1)&"" ""&LEFT(F2,FIND("" "",F2)-1)&"" ""&RIGHT(F2,4),""dd/mm/yyyy"")" .Range("K2").Formula = "=I2+J2" .Range("L2").Formula = "=K2*AE2" .Range("M2").Formula = "=L2-N2" .Range("N2").Formula = "=P2*AE2" .Range("P2").Formula = "=IF(R2="""",K2*S2/100,K2*R2/100)" .Range("Q2").Formula = "=IF(R2="""",S2*100,R2*100)" .Range("AI2").Formula = "=IF(ISNA(VLOOKUP(D2,'SHEETNAME1'!G$1:G$" & lastrow_SHEETNAME1 & ",1,FALSE)),""NOT FOUND"",""FOUND"")" .Range("AJ2").Formula = "=D2=D1" .Range("AK2").Formula = "=IF(COUNTIF($A$1:A2,A2)>1,""AGGREGATE"",SUMIF($A$1:$A$" & lastrow_FinalABC & ",A2,$L$1:$L$" & lastrow_FinalABC & ")-SUMIF('SHEETNAME1'!$A$1:$A$" & lastrow_SHEETNAME1 & ",A2,'SHEETNAME1'!$F$1:$F$" & lastrow_SHEETNAME1 & "))" .Range("AL2").Formula = "=IF(A2=A1,AL1,IF(AND(AK2>-0.1,AK2<0.1),""MATCHED GROSS AMOUNT ISIN BY MONTH"",""GROSS AMOUNT NOT MATCHED ISIN BY MONTH""))" .Range("AM2").Formula = "=IF(COUNTIF($A$1:A2,A2)>1,""AGGREGATE"",SUMIF($A$1:$A$" & lastrow_FinalABC & ",A2,$K$1:$K$" & lastrow_FinalABC & ")-SUMIF('SHEETNAME1'!$A$1:$A$" & lastrow_SHEETNAME1 & ",A2,'SHEETNAME1'!$AO$1:$AO$" & lastrow_SHEETNAME1 & "))" .Range("AR2").Formula = "=IF(COUNTIF($A$1:A2,A2)>1,""AGGREGATE"",SUMIF($A$1:$A$" & lastrow_FinalABC & ",A2,$P$1:$P$" & lastrow_FinalABC & ")-SUMIF('SHEETNAME1'!$A$1:$A$" & lastrow_SHEETNAME1 & ",A2,'SHEETNAME1'!$J$1:$J$" & lastrow_SHEETNAME1 & "))" .Range("AS2").Formula = "=IF(A2=A1,AS1,IF(AND(AR2>-0.1,AR2<0.1),""MATCHED TAX AMOUNT ISIN BY MONTH"",""TAX AMOUNT NOT MATCHED ISIN BY MONTH""))" .Range("AT2").Formula = "=IF(COUNTIF($A$1:A2,A2)>1,""AGGREGATE"",SUMIF($A$1:$A$" & lastrow_FinalABC & ",A2,$O$1:$O$" & lastrow_FinalABC & ")-SUMIF('SHEETNAME1'!$A$1:$A$" & lastrow_SHEETNAME1 & ",A2,'SHEETNAME1'!$I$1:$I$" & lastrow_SHEETNAME1 & "))" End With End With End Sub ' Copy the updated formula on the FinalABC sheet down for all populated rows. Sub M10410_Copy_Post_FinalABC_Formulae_Down() Dim mycell As Variant Dim lastrow_FinalABC As Long ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Copy post FinalABC formulae down?", vbYesNo) = vbNo Then Exit Sub End If ' Update StatusBar. Application.StatusBar = "Copy post-FinalABC Formulae down..." With Workbooks(wb_name) With .Sheets("FinalABC") ' Activate the sheet. .Activate ' Get how many rows of data have been loaded into the sheet. lastrow_FinalABC = .Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_FinalABC < 3 Then lastrow_FinalABC = 3 End If ' For Each mycell In Workbooks(my1042Rec).Sheets("FinalABC").Range("AE2", Range("AE65536").End(xlUp).Offset(0, -1)) For Each mycell In .Range("AE2:AE" & lastrow_FinalABC) If Not mycell Like "*[0-9]*" Then mycell.Formula = 1 Next mycell ' Copies formulae down. .Range("M2:N2").AutoFill Destination:=.Range("M2:N" & lastrow_FinalABC) .Range("P2").AutoFill Destination:=.Range("P2:P" & lastrow_FinalABC) .Range("Q2").AutoFill Destination:=.Range("Q2:Q" & lastrow_FinalABC) .Range("AI2:AM2").AutoFill Destination:=.Range("AI2:AM" & lastrow_FinalABC) .Range("AR2:AT2").AutoFill Destination:=.Range("AR2:AT" & lastrow_FinalABC) ' Calculations. .Range("M2:N" & lastrow_FinalABC).Calculate .Range("P2:P" & lastrow_FinalABC).Calculate .Range("Q2:Q" & lastrow_FinalABC).Calculate 'TODO below calc is not needed now. Only needed once SHEETNAME1 file is loaded, as AG to AK use SHEETNAME1 data. .Range("AI2:AM" & lastrow_FinalABC).Calculate .Range("AR2:AT" & lastrow_FinalABC).Calculate ' Now copy and paste formula ranges as values to speed up the file processing. .Range("M3:N" & lastrow_FinalABC) = .Range("M3:N" & lastrow_FinalABC).Value .Range("P3:P" & lastrow_FinalABC) = .Range("P3:P" & lastrow_FinalABC).Value .Range("Q3:Q" & lastrow_FinalABC) = .Range("Q3:Q" & lastrow_FinalABC).Value .Range("AI3:AM" & lastrow_FinalABC) = .Range("AI3:AM" & lastrow_FinalABC).Value .Range("AR3:AT" & lastrow_FinalABC) = .Range("AR3:AT" & lastrow_FinalABC).Value End With End With ' Clear all objects. Set mycell = Nothing End Sub ' Copy the updated formula on the FinalABC sheet down for all populated rows. ' Speeds this up using Arrays Sub M10415_Copy_Post_FinalABC_Formulae_Down_Array() Dim mycell As Variant Dim lastrow_SHEETNAME1 As Long Dim lastrow_FinalABC As Long Dim working As Variant Dim column_a_FinalABC As Variant Dim column_d_FinalABC As Variant Dim column_k_FinalABC As Variant Dim column_l_FinalABC As Variant Dim column_n_FinalABC As Variant Dim column_o_FinalABC As Variant Dim column_p_FinalABC As Variant Dim column_r_FinalABC As Variant Dim column_s_FinalABC As Variant Dim column_ae_FinalABC As Variant Dim column_ak_FinalABC As Variant Dim column_al_FinalABC As Variant Dim column_a_SHEETNAME1 As Variant Dim column_f_SHEETNAME1 As Variant Dim column_g_SHEETNAME1 As Variant Dim column_i_SHEETNAME1 As Variant Dim column_j_SHEETNAME1 As Variant Dim column_ao_SHEETNAME1 As Variant Dim n As Long ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Copy post FinalABC formulae down?", vbYesNo) = vbNo Then Exit Sub End If ' Update StatusBar. Application.StatusBar = "Copy post-FinalABC Formulae down..." With Workbooks(wb_name) ' Get how many rows of data have been loaded into the sheet. lastrow_SHEETNAME1 = Sheets("SHEETNAME1").Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_SHEETNAME1 < 3 Then lastrow_SHEETNAME1 = 3 End If With .Sheets("FinalABC") ' Activate the sheet. .Activate ' Get how many rows of data have been loaded into the sheet. lastrow_FinalABC = .Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_FinalABC < 3 Then lastrow_FinalABC = 3 End If ReDim working(1 To lastrow_FinalABC, 1) ' Working array working = Range("D3:D" & lastrow_FinalABC) ' load with dummy values. ReDim column_a_FinalABC(1 To lastrow_FinalABC, 1) ReDim column_k_FinalABC(1 To lastrow_FinalABC, 1) ReDim column_l_FinalABC(1 To lastrow_FinalABC, 1) ReDim column_n_FinalABC(1 To lastrow_FinalABC, 1) ReDim column_o_FinalABC(1 To lastrow_FinalABC, 1) ReDim column_p_FinalABC(1 To lastrow_FinalABC, 1) ReDim column_r_FinalABC(1 To lastrow_FinalABC, 1) ReDim column_s_FinalABC(1 To lastrow_FinalABC, 1) ReDim column_ae_FinalABC(1 To lastrow_FinalABC, 1) ReDim column_ak_FinalABC(1 To lastrow_FinalABC, 1) ReDim column_al_FinalABC(1 To lastrow_FinalABC, 1) ReDim column_a_SHEETNAME1(1 To lastrow_SHEETNAME1, 1) ReDim column_f_SHEETNAME1(1 To lastrow_SHEETNAME1, 1) ReDim column_g_SHEETNAME1(1 To lastrow_SHEETNAME1, 1) ReDim column_i_SHEETNAME1(1 To lastrow_SHEETNAME1, 1) ReDim column_j_SHEETNAME1(1 To lastrow_SHEETNAME1, 1) ReDim column_ao_SHEETNAME1(1 To lastrow_SHEETNAME1, 1) ' Column AE ' FX_Rate working = Range("AE3:AE" & lastrow_FinalABC) column_ae_FinalABC = Range("AE3:AE" & lastrow_FinalABC) For n = LBound(working) To UBound(working) If Not column_ae_FinalABC(n, 1) Like "*[0-9]*" Then working(n, 1) = 1 End If Next n .Range("AE3:AE" & lastrow_FinalABC).Value = working ' Column P - needed before column N ' =IF(R2="",K2*S2/100,K2*R2/100) column_r_FinalABC = Range("R3:R" & lastrow_FinalABC) column_k_FinalABC = Range("O3:O" & lastrow_FinalABC) column_s_FinalABC = Range("S3:S" & lastrow_FinalABC) For n = LBound(working) To UBound(working) If column_r_FinalABC(n, 1) = "" Then working(n, 1) = column_k_FinalABC(n, 1) * column_s_FinalABC(n, 1) / 100 Else working(n, 1) = column_k_FinalABC(n, 1) * column_r_FinalABC(n, 1) / 100 End If Next n .Range("P3:P" & lastrow_FinalABC).Value = working ' Column N - needed before column M ' =P2*AE2 column_p_FinalABC = Range("P3:P" & lastrow_FinalABC) column_ae_FinalABC = Range("AE3:AE" & lastrow_FinalABC) For n = LBound(working) To UBound(working) working(n, 1) = column_p_FinalABC(n, 1) * column_ae_FinalABC(n, 1) Next n .Range("N3:N" & lastrow_FinalABC).Value = working ' Column M '=L2-N2 column_l_FinalABC = Range("L3:L" & lastrow_FinalABC) column_n_FinalABC = Range("N3:N" & lastrow_FinalABC) For n = LBound(working) To UBound(working) working(n, 1) = column_l_FinalABC(n, 1) - column_n_FinalABC(n, 1) Next n .Range("M3:M" & lastrow_FinalABC).Value = working ' Column Q ' =IF(R2="",S2*100,R2*100) column_r_FinalABC = Range("R3:R" & lastrow_FinalABC) column_s_FinalABC = Range("S3:S" & lastrow_FinalABC) For n = LBound(working) To UBound(working) If column_r_FinalABC(n, 1) = "" Then working(n, 1) = column_s_FinalABC(n, 1) * 100 Else working(n, 1) = column_r_FinalABC(n, 1) * 100 End If Next n .Range("Q3:Q" & lastrow_FinalABC).Value = working ' Column AI ' =IF(ISNA(VLOOKUP(D2,SHEETNAME1!G$1:G$52435,1,FALSE)),"NOT FOUND","FOUND") column_d_FinalABC = Range("D3:D" & lastrow_FinalABC) column_g_SHEETNAME1 = Range("G3:G" & lastrow_SHEETNAME1) For n = LBound(working) To UBound(working) working(n, 1) = ArrayFindEx(column_g_SHEETNAME1, column_d_FinalABC(n, 1), "FOUND", "NOT FOUND") Next n .Range("AI3:AI" & lastrow_FinalABC).Value = working ' Column AJ 'D2=D1 .Range("AJ2:AJ2").AutoFill Destination:=.Range("AJ2:AJ" & lastrow_FinalABC) ' Column AK ' =IF(COUNTIF($A$1:A2,A2)>1,"AGGREGATE",SUMIF($A$1:$A$2227,A2,$L$1:$L$2227)-SUMIF(SHEETNAME1!$A$1:$A$52435,A2,SHEETNAME1!$F$1:$F$52435)) column_a_FinalABC = Range("A3:A" & lastrow_FinalABC) column_l_FinalABC = Range("L3:L" & lastrow_FinalABC) column_a_SHEETNAME1 = Sheets("SHEETNAME1").Range("A3:A" & lastrow_SHEETNAME1) column_f_SHEETNAME1 = Sheets("SHEETNAME1").Range("F3:F" & lastrow_SHEETNAME1) For n = LBound(working) To UBound(working) If ArrayCountIf(column_a_FinalABC, column_a_FinalABC(n, 1)) > 1 Then working(n, 1) = "AGGREGATE" Else working(n, 1) = ArraySumIf(column_a_FinalABC, column_a_FinalABC(n, 1), column_l_FinalABC) - ArraySumIf(column_a_SHEETNAME1, column_a_FinalABC(n, 1), column_f_SHEETNAME1) End If Next n .Range("AK3:AK" & lastrow_FinalABC).Value = working ' Column AL ' =IF(A2=A1,AL1,IF(AND(AK2>-0.1,AK2<0.1),"MATCHED GROSS AMOUNT ISIN BY MONTH","GROSS AMOUNT NOT MATCHED ISIN BY MONTH")) ' column_a_FinalABC = Range("A3:A" & lastrow_FinalABC) ' column_aj_FinalABC = Range("AJ3:AJ" & lastrow_FinalABC) ' column_ai_FinalABC = Range("AI3:AJ" & lastrow_FinalABC) ' For n = LBound(working) To UBound(working) ' If column_a_FinalABC(n, 1) = column_a_FinalABC(n - 1, 1) Then ' working(n, 1) = column_aj_FinalABC(n - 1, 1) ' Else ' If column_ai_FinalABC(n, 1) > -0.1 And column_ai_FinalABC(n, 1) < 0.1 Then ' working(n, 1) = "MATCHED GROSS AMOUNT ISIN BY MONTH" ' Else ' working(n, 1) = "GROSS AMOUNT NOT MATCHED ISIN BY MONTH" ' End If ' End If ' Next n ' ' .Range("AM3:AM" & lastrow_FinalABC).Value = working .Range("AL2").AutoFill Destination:=.Range("AL2:AL" & lastrow_FinalABC) .Range("AL2:AL" & lastrow_FinalABC).Calculate .Range("AL3:AL" & lastrow_FinalABC) = .Range("AL3:AL" & lastrow_FinalABC).Value ' Column AM ' =IF(COUNTIF($A$1:A2,A2)>1,"AGGREGATE",SUMIF($A$1:$A$2227,A2,$K$1:$K$2227)-SUMIF(SHEETNAME1!$A$1:A$52435,A2,SHEETNAME1!$AO$1:$AO$52435)) column_a_FinalABC = Range("A3:A" & lastrow_FinalABC) column_k_FinalABC = Range("K3:K" & lastrow_FinalABC) column_a_SHEETNAME1 = Sheets("SHEETNAME1").Range("A3:A" & lastrow_SHEETNAME1) column_ao_SHEETNAME1 = Sheets("SHEETNAME1").Range("AO3:AO" & lastrow_SHEETNAME1) For n = LBound(working) To UBound(working) If ArrayCountIf(column_a_FinalABC, column_a_FinalABC(n, 1)) > 1 Then working(n, 1) = "AGGREGATE" Else working(n, 1) = ArraySumIf(column_a_FinalABC, column_a_FinalABC(n, 1), column_k_FinalABC) - ArraySumIf(column_a_SHEETNAME1, column_a_FinalABC(n, 1), column_ao_SHEETNAME1) End If Next n .Range("AM3:AM" & lastrow_FinalABC).Value = working ' Column AR ' =IF(COUNTIF($A$1:A2,A2)>1,"AGGREGATE",SUMIF($A$1:$A$2227,A2,$P$1:$P$2227)-SUMIF(SHEETNAME1!$A$1:$A$52435,A2,SHEETNAME1!$J$1:$J$52435)) column_a_FinalABC = Range("A3:A" & lastrow_FinalABC) column_p_FinalABC = Range("P3:P" & lastrow_FinalABC) column_a_SHEETNAME1 = Sheets("SHEETNAME1").Range("A3:A" & lastrow_SHEETNAME1) column_j_SHEETNAME1 = Sheets("SHEETNAME1").Range("J3:J" & lastrow_SHEETNAME1) For n = LBound(working) To UBound(working) If ArrayCountIf(column_a_FinalABC, column_a_FinalABC(n, 1)) > 1 Then working(n, 1) = "AGGREGATE" Else working(n, 1) = ArraySumIf(column_a_FinalABC, column_a_FinalABC(n, 1), column_p_FinalABC) - ArraySumIf(column_a_SHEETNAME1, column_a_FinalABC(n, 1), column_j_SHEETNAME1) End If Next n .Range("AR3:AR" & lastrow_FinalABC).Value = working ' Column AS ' =IF(A2=A1,AS1,IF(AND(AR2>-0.1,AR2<0.1),"MATCHED TAX AMOUNT ISIN BY MONTH","TAX AMOUNT NOT MATCHED ISIN BY MONTH")) ' column_a_FinalABC = Range("A3:A" & lastrow_FinalABC) ' column_aq_FinalABC = Range("AQ3:AQ" & lastrow_FinalABC) ' column_ap_FinalABC = Range("AP3:AP" & lastrow_FinalABC) ' For n = LBound(working) To UBound(working) ' If column_a_FinalABC(n, 1) = column_a_FinalABC(n - 1, 1) Then ' working(n, 1) = column_aq_FinalABC(n - 1, 1) ' Else ' If column_ap_FinalABC(n, 1) > -0.1 And column_ap_FinalABC(n, 1) < 0.1 Then ' working(n, 1) = "MATCHED TAX AMOUNT ISIN BY MONTH" ' Else ' working(n, 1) = "TAX AMOUNT NOT MATCHED ISIN BY MONTH" ' End If ' End If ' Next n ' ' .Range("AS3:AS" & lastrow_FinalABC).Value = working .Range("AS2").AutoFill Destination:=.Range("AS2:AS" & lastrow_FinalABC) .Range("AS2:AS" & lastrow_FinalABC).Calculate .Range("AS3:AS" & lastrow_FinalABC) = .Range("AS3:AS" & lastrow_FinalABC).Value ' Column AT ' =IF(COUNTIF($A$1:A2,A2)>1,"AGGREGATE",SUMIF($A$1:$A$2227,A2,$O$1:$O$2227)-SUMIF(SHEETNAME1!$A$1:$A$52435,A2,SHEETNAME1!$I$1:$I$52435)) column_a_FinalABC = Range("A3:A" & lastrow_FinalABC) column_o_FinalABC = Range("O3:O" & lastrow_FinalABC) column_a_SHEETNAME1 = Sheets("SHEETNAME1").Range("A3:A" & lastrow_SHEETNAME1) column_i_SHEETNAME1 = Sheets("SHEETNAME1").Range("I3:I" & lastrow_SHEETNAME1) For n = LBound(working) To UBound(working) If ArrayCountIf(column_a_FinalABC, column_a_FinalABC(n, 1)) > 1 Then working(n, 1) = "AGGREGATE" Else working(n, 1) = ArraySumIf(column_a_FinalABC, column_a_FinalABC(n, 1), column_o_FinalABC) - ArraySumIf(column_a_SHEETNAME1, column_a_FinalABC(n, 1), column_i_SHEETNAME1) End If Next n .Range("AT3:AT" & lastrow_FinalABC).Value = working End With End With ' Clear all objects. Set mycell = Nothing Set working = Nothing Set column_a_FinalABC = Nothing Set column_d_FinalABC = Nothing Set column_k_FinalABC = Nothing Set column_l_FinalABC = Nothing Set column_n_FinalABC = Nothing Set column_o_FinalABC = Nothing Set column_p_FinalABC = Nothing Set column_r_FinalABC = Nothing Set column_s_FinalABC = Nothing Set column_ae_FinalABC = Nothing Set column_ak_FinalABC = Nothing Set column_al_FinalABC = Nothing Set column_a_SHEETNAME1 = Nothing Set column_f_SHEETNAME1 = Nothing Set column_i_SHEETNAME1 = Nothing Set column_j_SHEETNAME1 = Nothing Set column_ao_SHEETNAME1 = Nothing End Sub ' Copy pre SHEETNAME1 formula down. ' Just enough data to allow SHEETNAME1 sheet to be sorted. Sub M10500_Copy_Pre_SHEETNAME1_Formulae_Down() Dim lastrow_SHEETNAME1 As Long ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Copy pre SHEETNAME1 formulae down?", vbYesNo) = vbNo Then Exit Sub End If ' Update StatusBar. Application.StatusBar = "Copy pre-SHEETNAME1 Formulae down..." With Workbooks(wb_name) With .Sheets("SHEETNAME1") ' Activate the sheet. .Activate ' Get how many rows of data have been loaded into the sheet. lastrow_SHEETNAME1 = .Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_SHEETNAME1 < 3 Then lastrow_SHEETNAME1 = 3 End If ' Copies formulae down. .Range("A2:B2").AutoFill Destination:=.Range("A2:B" & lastrow_SHEETNAME1) ' Calculations. .Range("A2:B" & lastrow_SHEETNAME1).Calculate ' Now copy and paste formula ranges as values to speed up the file processing. .Range("A3:A" & lastrow_SHEETNAME1) = .Range("A3:A" & lastrow_SHEETNAME1).Value .Range("B3:B" & lastrow_SHEETNAME1) = .Range("B3:B" & lastrow_SHEETNAME1).Value ' Select A1. ScrollTo ActiveSheet.name, "A1" End With End With End Sub ' Copy pre SHEETNAME1 formula down using Arrays for speed. ' Just enough data to allow SHEETNAME1 sheet to be sorted. Sub M10505_Copy_Pre_SHEETNAME1_Formulae_Down_array() Dim lastrow_SHEETNAME1 As Long Dim lastrow_SECT As Long Dim working As Variant Dim column_a As Variant Dim column_b As Variant Dim column_c As Variant Dim column_n As Variant Dim column_a_SECT As Variant Dim column_b_SECT As Variant Dim n As Long ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Copy pre SHEETNAME1 formulae down?", vbYesNo) = vbNo Then Exit Sub End If ' Update StatusBar. Application.StatusBar = "Copy pre-SHEETNAME1 Formulae down..." With Workbooks(wb_name) With .Sheets("SHEETNAME1") ' Activate the sheet. .Activate ' Get how many rows of data have been loaded into the sheet. lastrow_SHEETNAME1 = .Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_SHEETNAME1 < 3 Then lastrow_SHEETNAME1 = 3 End If lastrow_SECT = Sheets("SECT").Cells(Rows.Count, 1).End(xlUp).Row ReDim working(1 To lastrow_SHEETNAME1, 1) ' Working array working = Range("N3:N" & lastrow_SHEETNAME1) ' load with dummy values. ReDim column_a(1 To lastrow_SHEETNAME1, 1) ReDim column_b(1 To lastrow_SHEETNAME1, 1) ReDim column_c(1 To lastrow_SHEETNAME1, 1) ReDim column_n(1 To lastrow_SHEETNAME1, 1) ReDim column_a_SECT(1 To lastrow_SECT, 1) ReDim column_b_SECT(1 To lastrow_SECT, 1) ' Column B '=IFERROR(VLOOKUP(N2,SECT!A$1:B$50021,2,FALSE),"") column_n = Range("N3:N" & lastrow_SHEETNAME1) column_a_SECT = Sheets("SECT").Range("A3:A" & lastrow_SECT) column_b_SECT = Sheets("SECT").Range("B3:B" & lastrow_SECT) For n = LBound(working) To UBound(working) working(n, 1) = ArrayFind(column_a_SECT, column_n(n, 1), column_b_SECT, "") Next n .Range("B3:B" & lastrow_SHEETNAME1).Value = working ' Column A '=B2&" - "&TEXT(C2,"MMM")&" "&YEAR(C2) column_b = Range("B3:B" & lastrow_SHEETNAME1) column_c = Range("C3:C" & lastrow_SHEETNAME1) For n = LBound(working) To UBound(working) working(n, 1) = column_b(n, 1) & " - " & WorksheetFunction.Text(column_c(n, 1), "MMM") & " " & Year(column_c(n, 1)) Next n .Range("A3:A" & lastrow_SHEETNAME1).Value = working ' Select A1. ScrollTo ActiveSheet.name, "A1" End With End With ' Clear all objects. Set working = Nothing Set column_a = Nothing Set column_b = Nothing Set column_c = Nothing Set column_n = Nothing Set column_a_SECT = Nothing Set column_b_SECT = Nothing End Sub ' Sorts the SHEETNAME1 sheet by Columns A and M in ascending order. Sub M10510_Sort_SHEETNAME1_column_A() Dim lastrow_SHEETNAME1 As Long ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Sort SHEETNAME1 column A?", vbYesNo) = vbNo Then Exit Sub End If ' Update StatusBar. Application.StatusBar = "Sort SHEETNAME1...Column A and M" With Workbooks(wb_name) With .Sheets("SHEETNAME1") ' Active the sheet. .Activate ' Get how many rows of data have been loaded into the sheet. lastrow_SHEETNAME1 = .Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_SHEETNAME1 < 3 Then lastrow_SHEETNAME1 = 3 End If ' Checks if all ISINs are populated. If WorksheetFunction.CountA(.Columns("B")) <> WorksheetFunction.CountA(.Columns("M")) Then 'If MsgBox("There are still missing ISIN's in the SHEETNAME1 sheet, column B. Either run the macro entitled 'find_ISINs' or manually add them. Do you want to continue sorting?", vbYesNo) = vbNo Then If MsgBox("There are still missing ISIN's in the SHEETNAME1 sheet, column B, which can be manually added in. Do you want to continue sorting?", vbYesNo) = vbNo Then Exit Sub End If End If ' Do the sort. With .Sort '.AutoFilter With .SortFields .Clear .Add Key:=Range("A1:A" & lastrow_SHEETNAME1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .Add Key:=Range("N1:N" & lastrow_SHEETNAME1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal End With .SetRange Range("A1:BO" & lastrow_SHEETNAME1) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With ' Select A1. ScrollTo ActiveSheet.name, "A1" End With End With End Sub ' Updates the formulae on the SHEETNAME1 sheet to only reference the specific number of rows actually loaded into the SHEETNAME1 sheet ' instead of something like A:A which would reference over 1 million rows and therefore may slow down calculations etc. Sub M10520_Update_SHEETNAME1_Formulae() Dim lastrow_SHEETNAME1 As Long Dim lastrow_SECT As Long Dim lastrow_References As Long Dim lastrow_References_adjusted_rate As Long Dim lastrow_References_g3_location As Long Dim lastrow_References_excemption_code As Long Dim lastrow_References_allowed_locations As Long Dim lastrow_FinalABC As Long Dim lastrow_MappingPivots As Long Dim lastrow_MappingPivots2 As Long Dim lastrow_MappingPivots3 As Long Dim lastrow_Wxxxx As Long Dim lastrow_HOLDINGS As Long Dim lastrow_TRANSACTIONS As Long Dim lastrow_CUST As Long Dim lastrow_QSHEET As Long ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Update SHEETNAME1 formulae?", vbYesNo) = vbNo Then Exit Sub End If ' Update StatusBar. Application.StatusBar = "Update SHEETNAME1 Formulae..." With Workbooks(wb_name) ' Get how many rows of data have been loaded into the sheet. lastrow_SHEETNAME1 = .Sheets("SHEETNAME1").Cells(Rows.Count, 4).End(xlUp).Row lastrow_SECT = .Sheets("SECT").Cells(Rows.Count, 1).End(xlUp).Row lastrow_References = .Sheets("References").Cells(Rows.Count, 1).End(xlUp).Row lastrow_References_adjusted_rate = .Sheets("References").Cells(Rows.Count, 8).End(xlUp).Row lastrow_References_g3_location = .Sheets("References").Cells(Rows.Count, 15).End(xlUp).Row lastrow_References_excemption_code = .Sheets("References").Cells(Rows.Count, 19).End(xlUp).Row lastrow_References_allowed_locations = .Sheets("References").Cells(Rows.Count, 33).End(xlUp).Row lastrow_FinalABC = .Sheets("FinalABC").Cells(Rows.Count, 1).End(xlUp).Row lastrow_HOLDINGS = .Sheets("HOLDINGS").Cells(Rows.Count, 1).End(xlUp).Row lastrow_MappingPivots = .Sheets("Mapping Pivots").Cells(Rows.Count, 1).End(xlUp).Row lastrow_MappingPivots2 = .Sheets("Mapping Pivots").Cells(Rows.Count, 6).End(xlUp).Row lastrow_MappingPivots3 = .Sheets("Mapping Pivots").Cells(Rows.Count, 11).End(xlUp).Row lastrow_Wxxxx = .Sheets("Wxxxx").Cells(Rows.Count, 2).End(xlUp).Row lastrow_TRANSACTIONS = .Sheets("TRANSACTIONS").Cells(Rows.Count, 2).End(xlUp).Row lastrow_CUST = .Sheets("CUST").Cells(Rows.Count, 1).End(xlUp).Row lastrow_QSHEET = .Sheets("QSHEET").Cells(Rows.Count, 1).End(xlUp).Row ' Updates formulae on SHEETNAME1. With .Sheets("SHEETNAME1") ' Activate the sheet. .Activate .Range("A2").Formula = "=B2&"" - ""&TEXT(C2,""MMM"")&"" ""&YEAR(C2)" .Range("B2").Formula = "=IFERROR(VLOOKUP(N2,SECT!A$1:B$" & lastrow_SECT & ",2,FALSE),"""")" .Range("F2").Formula = "=IF(Y2=""EXCLUDE"",0,G2)" .Range("H2").Formula = "=G2-J2" .Range("J2").Formula = "=IF(K2="""",I2,IF(L2="""",I2,IF(OR(L2=0,K2=0),0,I2/(L2/K2))))" .Range("L2").Formula = "=IF(G2=0,0,I2/G2)" .Range("M2").Formula = "=VLOOKUP(U2,References!A$1:B$" & lastrow_References & ",2,FALSE)" .Range("T2").Formula = "=VLOOKUP(R2,CUST!$A$1:$B$" & lastrow_CUST & ",2,FALSE)" .Range("V2").Formula = "=IF(ISNA(VLOOKUP(B2,FinalABC!$D$1:$D$" & lastrow_FinalABC & ",1,FALSE)),""NON EXIST"",""EXIST"")" .Range("W2").Formula = "=B2=B1" .Range("X2").Formula = "=IF(ISNA(VLOOKUP(A2,FinalABC!A$1:A$" & lastrow_FinalABC & ",1,FALSE)),""NON EXIST"",""EXIST"")" .Range("AB2").Formula = "=IF(OR(X2=""NON EXIST"",Y2=""EXCLUDE""),""NON REPORTABLE"",A2&"" - ""&ROUND(F2,0))" .Range("AC2").Formula = "=IF(OR($X2=""NON EXIST"",$Y2=""EXCLUDE""),""NON REPORTABLE"",IFERROR(VLOOKUP($A2,'Mapping Pivots'!$A$4:$B$" & lastrow_MappingPivots & ",2,FALSE), IFERROR(VLOOKUP($AB2,'Mapping Pivots'!$F$4:$G$" & lastrow_MappingPivots2 & ",2,FALSE), ""MANUAL INPUT"")))" .Range("AE2").Formula = "=IF(OR($X2=""NON EXIST"",$Y2=""EXCLUDE""),""NON REPORTABLE"",IFERROR(VLOOKUP($A2,'Mapping Pivots'!$A$4:$C$" & lastrow_MappingPivots & ",3,FALSE),IFERROR(VLOOKUP($AB2,'Mapping Pivots'!$F$4:$H$" & lastrow_MappingPivots2 & ",3,FALSE), ""MANUAL INPUT"")))" .Range("AG2").Formula = "=IF(OR($X2=""NON EXIST"",$Y2=""EXCLUDE""),""NON REPORTABLE"",IF(COUNTIF($A$2:A2,A2)>1,""AGGREGATE"",ROUND(SUMIF($A$1:$A$" & lastrow_SHEETNAME1 & ",A2,$J$1:$J$" & lastrow_SHEETNAME1 & ")-SUMIF(FinalABC!$A$1:$A$" & lastrow_FinalABC & ",A2,FinalABC!$N$1:$N$" & lastrow_FinalABC & "),2)))" .Range("AH2").Formula = "=IF(AG2=""NON REPORTABLE"",AG2,IF(AND(ROUND(SUMIFS($J$1:$J$" & lastrow_SHEETNAME1 & ",$A$1:$A$" & lastrow_SHEETNAME1 & ",A2,$Y$1:$Y$" & lastrow_SHEETNAME1 & ",""INCLUDE"")-SUMIF(FinalABC!$A$1:$A$" & lastrow_FinalABC & ",A2,FinalABC!$N$1:$N$" & lastrow_FinalABC & "),2)>-1,ROUND(SUMIFS($J$1:$J$" & lastrow_SHEETNAME1 & ",$A$1:$A$" & lastrow_SHEETNAME1 & ",A2,$Y$1:$Y$" & lastrow_SHEETNAME1 & ",""INCLUDE"")-SUMIF(FinalABC!$A$1:$A$" & lastrow_FinalABC & ",A2,FinalABC!$N$1:$N$" & lastrow_FinalABC & "),2)<1),K2,""MANUAL INPUT""))" .Range("AJ2").Formula = "=IF(OR($X2=""NON EXIST"",$Y2=""EXCLUDE""),""NON REPORTABLE"",ROUND(E2*SUM(AI2/100),2))" .Range("AK2").Formula = "=IF(OR($X2=""NON EXIST"",$Y2=""EXCLUDE""),""NON REPORTABLE"",SUMIF($A$1:$A$" & lastrow_SHEETNAME1 & ",A2,$AJ$1:$AJ$" & lastrow_SHEETNAME1 & ")-SUMIF(FinalABC!$A$1:$A$" & lastrow_FinalABC & ",A2,FinalABC!$N$1:$N$" & lastrow_FinalABC & "))" .Range("AL2").Formula = "=IF(OR($X2=""NON EXIST"",$Y2=""EXCLUDE""), ""NON REPORTABLE"", IFERROR(VLOOKUP($A2,'Mapping Pivots'!$A$4:$D$" & lastrow_MappingPivots & ",4,FALSE), IFERROR(VLOOKUP($AB2,'Mapping Pivots'!$F$4:$I$" & lastrow_MappingPivots2 & ",4,FALSE), ""MANUAL INPUT"")))" .Range("AN2").Formula = "=IF(OR($X2=""NON EXIST"",$Y2=""EXCLUDE""),""NON REPORTABLE"",IFERROR(VLOOKUP(A2&"" - ""&AM2,'Mapping Pivots'!$K$4:$M$" & lastrow_MappingPivots & ",2,FALSE),0))" .Range("AO2").Formula = "=IF(OR($X2=""NON EXIST"",$Y2=""EXCLUDE""),""NON REPORTABLE"",IF(AN2=0,0,F2/AN2))" .Range("AP2").Formula = "=IF(OR($X2=""NON EXIST"",$Y2=""EXCLUDE""),""NON REPORTABLE"",IF(COUNTIF($A$1:A2,A2)>1,""AGGREGATE"",SUMIF($A$1:$A$" & lastrow_SHEETNAME1 & ",A2,$AO$1:$AO$" & lastrow_SHEETNAME1 & ")-SUMIF(FinalABC!$A$1:$A$" & lastrow_FinalABC & ",A2,FinalABC!$K$1:$K$" & lastrow_FinalABC & ")))" .Range("AQ2").Formula = "=IF(OR($X2=""NON EXIST"",$Y2=""EXCLUDE""),""NON REPORTABLE"",T2&"" - ""& IFERROR(IF(VLOOKUP(R2,Wxxxx!$B$1:$Z" & lastrow_Wxxxx & ",24,FALSE)=""YES"", ""VALID"", ""INVALID""),""INVALID"")&"" - "" & IFERROR(VLOOKUP(R2,Wxxxx!$B$1:$Z$" & lastrow_Wxxxx & ",25,FALSE),""N"") &"" - ""&K2)" .Range("AR2").Formula = "=IF(OR($X2=""NON EXIST"",$Y2=""EXCLUDE""),""NON REPORTABLE"",IFERROR(VLOOKUP(AQ2,References!$H$1:$K$" & lastrow_References_adjusted_rate & ",2,FALSE),0))" .Range("AS2").Formula = "=IF(OR($X2=""NON EXIST"",$Y2=""EXCLUDE""),""NON REPORTABLE"",IFERROR(VLOOKUP(AQ2,References!$H$1:$K$" & lastrow_References_adjusted_rate & ",3,FALSE),0))" .Range("AT2").Formula = "=IF(OR($X2=""NON EXIST"",$Y2=""EXCLUDE""),""NON REPORTABLE"",IFERROR(VLOOKUP(AQ2,References!$H$1:$K$" & lastrow_References_adjusted_rate & ",4,FALSE),0))" .Range("AV2").Formula = "=IF(OR($X2=""NON EXIST"",$Y2=""EXCLUDE""),""NON REPORTABLE"",IFERROR(VLOOKUP(AD2&"" - ""&AF2,References!S$1:W$" & lastrow_References_excemption_code & ",3,FALSE),0))" .Range("AW2").Formula = "=IF(OR($X2=""NON EXIST"",$Y2=""EXCLUDE""),""NON REPORTABLE"",IF(OR(AR2=""NO ADJUSTMENT REQUIRED"",K2=AU2),""NO ADJUSTMENT REQUIRED"",""ADJUST FROM ""&K2&""% TO ""&AU2&""% - BBH REPORTED ""&AI2&""%""))" .Range("AX2").Formula = "=IF(OR($X2=""NON EXIST"",$Y2=""EXCLUDE""),""NON REPORTABLE"",IF(R2=530572,""BPB&T IOM"",IF(T2=""IBGC"",""BPCI"",""BPB&T Jersey"")))" .Range("AY2").Formula = "=IF(AW2=""NO ADJUSTMENT REQUIRED"",""NO ADJUSTMENT REQUIRED"",IF(AW2=""NON REPORTABLE"",""NON REPORTABLE"",ROUND((F2*AU2%)-J2,2)))" .Range("BB2").Formula = "=IF(ISNA(VLOOKUP(U2,References!$AG$1:$AG$" & lastrow_References_allowed_locations & ",1,FALSE)),""NO ADJUSTMENT REQUIRED"",IF(AW2=""NO ADJUSTMENT REQUIRED"",""NO ADJUSTMENT REQUIRED"",IF(AW2=""NON REPORTABLE"",""NON REPORTABLE"",IFERROR(VLOOKUP(T2&"" - ""&AU2,References!$O$2:$Q$" & lastrow_References_g3_location & ",3,FALSE),0))))" .Range("BD2").Formula = "=IF(AW2=""NO ADJUSTMENT REQUIRED"",""NO ADJUSTMENT REQUIRED"",IF(AW2=""NON REPORTABLE"",""NON REPORTABLE"",IFERROR(VLOOKUP(T2& "" - "" &AU2,References!$O$2:$Q$" & lastrow_References_g3_location & ",2,FALSE),0)))" .Range("BE2").Formula = "=IF(AW2=""NO ADJUSTMENT REQUIRED"",""NO ADJUSTMENT REQUIRED"",IF(AW2=""NON REPORTABLE"",""NON REPORTABLE"",IF(BD2<>M2,""Yes"",""No"")))" .Range("BG2").Formula = "=IF(ISNA(VLOOKUP(R2&N2,HOLDINGS!A$1:A$" & lastrow_HOLDINGS & ",1,FALSE)),""NO HOLDINGS"",""STILL HAS HOLDINGS"")" .Range("BH2").Formula = "=IFERROR(VLOOKUP(R2&N2,HOLDINGS!A$1:F$" & lastrow_HOLDINGS & ",6,FALSE), ""NO HOLDINGS"")" .Range("BI2").Formula = "=IF(BH2=""NO HOLDINGS"",""NO HOLDINGS"",IFERROR(VLOOKUP(BH2,References!A$1:B$" & lastrow_References & ",2,FALSE),0))" .Range("BJ2").Formula = "=IF(OR(BB2=""NO ADJUSTMENT REQUIRED"",Y2=""EXCLUDE""),""NO ADJUSTMENT REQUIRED"",IFERROR(VLOOKUP(LEFT(P2,6)&TEXT(H2,""#.00"")&R2,TRANSACTIONS!A$1:L$" & lastrow_TRANSACTIONS & ",12,FALSE),0))" .Range("BK2").Formula = "=IF(OR(BB2=""NO ADJUSTMENT REQUIRED"",Y2=""EXCLUDE""),""NO ADJUSTMENT REQUIRED"",IFERROR(VLOOKUP(LEFT(P2,6)&TEXT(H2,""#.00"")&R2,TRANSACTIONS!A$1:M$" & lastrow_TRANSACTIONS & ",13,FALSE),0))" .Range("BL2").Formula = "=IF(OR(BB2=""NO ADJUSTMENT REQUIRED"",Y2=""EXCLUDE""),""NO ADJUSTMENT REQUIRED"",IFERROR(VLOOKUP(LEFT(P2,6)&TEXT(H2,""#.00"")&R2,TRANSACTIONS!A$1:N$" & lastrow_TRANSACTIONS & ",14,FALSE),0))" .Range("BM2").Formula = "=IF(ISNA(VLOOKUP(R2,QSHEET!A$1:A$" & lastrow_QSHEET & ",1,FALSE)),""NOT ON QSHEET"", ""ON QSHEET"")" End With End With End Sub ' Returns the number of vCrit found within the array oArrWithCrit. Function ArrayCountIfSequential(oArrWithCrit As Variant, vCrit As Variant) Dim lRow As Long For lRow = LBound(oArrWithCrit, 1) To UBound(oArrWithCrit, 1) If oArrWithCrit(lRow, 1) = vCrit Then ArrayCountIfSequential = ArrayCountIf + 1 End If Next End Function ' Binary Search of array. ' Returns the number of vCrit found within the array oArrWithCrit. Function ArrayCountIf(oArrWithCrit As Variant, vCrit As Variant) Dim low As Long low = LBound(oArrWithCrit) Dim high As Long high = UBound(oArrWithCrit) Dim i As Long Dim J As Long Dim result As Boolean ArrayCountIf = 0 Do While low <= high i = (low + high) / 2 If vCrit = oArrWithCrit(i, 1) Then ArrayCountIf = ArrayCountIf + 1 ' Now that found run sequentially while same value J = i - 1 i = i + 1 Do While (i <= high) If vCrit = oArrWithCrit(i, 1) Then ArrayCountIf = ArrayCountIf + 1 i = i + 1 Else Exit Do End If Loop Do While (J >= low) If vCrit = oArrWithCrit(J, 1) Then ArrayCountIf = ArrayCountIf + 1 J = J - 1 Else Exit Do End If Loop Exit Do ElseIf vCrit < oArrWithCrit(i, 1) Then high = (i - 1) Else low = (i + 1) End If Loop End Function ' Returns the sum of all oArrWithValues for all vCrit found within the array oArrWithCrit. Function ArraySumIfSequential(oArrWithCrit As Variant, vCrit As Variant, oArrWithValues As Variant) Dim vArr1 As Variant Dim vArr2 As Variant Dim lRow As Long If (UBound(oArrWithCrit) - LBound(oArrWithCrit)) = (UBound(oArrWithValues) - LBound(oArrWithValues)) Then For lRow = LBound(oArrWithCrit, 1) To UBound(oArrWithCrit, 1) If oArrWithCrit(lRow, 1) = vCrit Then ArraySumIfSequential = ArraySumIfSequential + oArrWithValues(lRow, 1) End If Next Else ArraySumIfSequential = "Criteriarange and sum range must be of same length" End If ' Clear all objects. Set vArr1 = Nothing Set vArr2 = Nothing End Function ' Returns the sum of all oArrWithValues for all vCrit found within the array oArrWithCrit. Function ArraySumIf(oArrWithCrit As Variant, vCrit As Variant, oArrWithValues As Variant) Dim low As Long low = LBound(oArrWithCrit) Dim high As Long high = UBound(oArrWithCrit) Dim i As Long Dim J As Long Dim result As Boolean ArraySumIf = 0 Do While low <= high i = (low + high) / 2 If vCrit = oArrWithCrit(i, 1) Then If IsNumeric(oArrWithValues(i, 1)) Then ArraySumIf = ArraySumIf + oArrWithValues(i, 1) End If ' Now that found run sequentially while same value i = i + 1 J = J - 1 Do While (i <= high) If vCrit = oArrWithCrit(i, 1) Then If IsNumeric(oArrWithValues(i, 1)) Then ArraySumIf = ArraySumIf + oArrWithValues(i, 1) End If i = i + 1 Else Exit Do End If Loop Do While (J >= low) If vCrit = oArrWithCrit(J, 1) Then If IsNumeric(oArrWithValues(i, 1)) Then ArraySumIf = ArraySumIf + oArrWithValues(i, 1) End If J = J - 1 Else Exit Do End If Loop Exit Do ElseIf vCrit < oArrWithCrit(i, 1) Then high = (i - 1) Else low = (i + 1) End If Loop End Function ' Returns the sum of all oArrWithValues for all vCrit found within the array oArrWithCrit. Function ArraySumIfx(oArrWithCrit As Variant, vCrit As Variant, oArrWithValues As Variant) Dim low As Long low = LBound(oArrWithCrit) Dim high As Long high = UBound(oArrWithCrit) Dim i As Long Dim J As Long Dim result As Boolean ArraySumIf = 0 Do While low <= high i = (low + high) / 2 If vCrit = oArrWithCrit(i, 1) Then ArraySumIf = ArraySumIf + oArrWithValues(i, 1) ' Now that found run sequentially while same value i = i + 1 J = J - 1 Do While (i <= high) If vCrit = oArrWithCrit(i, 1) Then ArraySumIf = ArraySumIf + oArrWithValues(i, 1) i = i + 1 Else Exit Do End If Loop Do While (J >= low) If vCrit = oArrWithCrit(J, 1) Then ArraySumIf = ArraySumIf + oArrWithValues(i, 1) J = J - 1 Else Exit Do End If Loop Exit Do ElseIf vCrit < oArrWithCrit(i, 1) Then high = (i - 1) Else low = (i + 1) End If Loop End Function ' Tries to find vCrit within oArrWithCrit. ' If found then return corresponding oArrWithValues otherwise vDefault. Function ArrayFindSequential(oArrWithCrit As Variant, vCrit As Variant, oArrWithValues As Variant, vDefault As Variant) Dim vArr1 As Variant Dim vArr2 As Variant Dim lRow As Long ArrayFindSequential = vDefault If (UBound(oArrWithCrit) - LBound(oArrWithCrit)) = (UBound(oArrWithValues) - LBound(oArrWithValues)) Then For lRow = LBound(oArrWithCrit, 1) To UBound(oArrWithCrit, 1) If oArrWithCrit(lRow, 1) = vCrit Then ArrayFindSequential = oArrWithValues(lRow, 1) Exit Function End If Next Else ArrayFindSequential = "Criteriarange and sum range must be of same length" End If ' Clear all objects. Set vArr1 = Nothing Set vArr2 = Nothing End Function ' Binary Search of array. ' Tries to find vCrit within oArrWithCrit. ' If found then return corresponding oArrWithValues otherwise vDefault. ' Note that due to way that binary search works this may not report on the very 1st instance of that vCrit if this ' was done sequentially. It will simply report on the 1st instance found and there may be various oArrWithValues ' data against the same vCrit. Function ArrayFind(oArrWithCrit As Variant, vCrit As Variant, oArrWithValues As Variant, vDefault As Variant) Dim low As Long low = LBound(oArrWithCrit) Dim high As Long high = UBound(oArrWithCrit) Dim i As Long Dim result As Boolean ArrayFind = vDefault Do While low <= high i = (low + high) / 2 If vCrit = oArrWithCrit(i, 1) Then ArrayFind = oArrWithValues(i, 1) Exit Do ElseIf vCrit < oArrWithCrit(i, 1) Then high = (i - 1) Else low = (i + 1) End If Loop End Function ' Tries to find vCrit within oArrWithCrit. ' If found then returns vFoundValue otherwise vNotFoundValue. '=ArrayFind(A1:A1000,"Foo",B1:B1000) Function ArrayFindSequentialEx(oArrWithCrit As Variant, vCrit As Variant, vFoundValue As Variant, vNotFoundValue As Variant) Dim vArr1 As Variant Dim vArr2 As Variant Dim lRow As Long ArrayFindSequentialEx = vNotFoundValue For lRow = LBound(oArrWithCrit, 1) To UBound(oArrWithCrit, 1) If oArrWithCrit(lRow, 1) = vCrit Then ArrayFindSequentialEx = vFoundValue Exit Function End If Next ' Clear all objects. Set vArr1 = Nothing Set vArr2 = Nothing End Function ' Tries to find vCrit within oArrWithCrit. ' If found then returns vFoundValue otherwise vNotFoundValue. ' Note that due to way that binary search works this may not report on the very 1st instance of that vCrit if this ' was done sequentially. It will simply report on the 1st instance found and there may be various oArrWithValues ' data against the same vCrit. Function ArrayFindEx(oArrWithCrit As Variant, vCrit As Variant, vFoundValue As Variant, vNotFoundValue As Variant) Dim low As Long low = LBound(oArrWithCrit) Dim high As Long high = UBound(oArrWithCrit) Dim i As Long Dim result As Boolean ArrayFindEx = vNotFoundValue Do While low <= high i = (low + high) / 2 If vCrit = oArrWithCrit(i, 1) Then ArrayFindEx = vFoundValue Exit Do ElseIf vCrit < oArrWithCrit(i, 1) Then high = (i - 1) Else low = (i + 1) End If Loop End Function '=ArrayCountIf(A1:A1000,"Foo",B1:B1000) Function RangeCountIf(oRngWithCrit As Range, vCrit As Variant) Dim vArr1 As Variant Dim lRow As Long vArr1 = oRngWithCrit.Value For lRow = LBound(vArr1, 1) To UBound(vArr1, 1) If vArr1(lRow, 1) = vCrit Then RangeCountIf = RangeCountIf + 1 End If Next ' Clear all objects. Set vArr1 = Nothing End Function '=ArraySumIf(A1:A1000,"Foo",B1:B1000) Function RangeSumIf(oRngWithCrit As Range, vCrit As Variant, oRngWithValues As Range) Dim vArr1 As Variant Dim vArr2 As Variant Dim lRow As Long If oRngWithCrit.Rows.Count = oRngWithValues.Rows.Count Then vArr1 = oRngWithCrit.Value vArr2 = oRngWithValues.Value For lRow = LBound(vArr1, 1) To UBound(vArr1, 1) If vArr1(lRow, 1) = vCrit Then RangeSumIf = ArraySumIf + vArr2(lRow, 1) End If Next Else RangeSumIf = "Criteriarange and sum range must be of same length" End If ' Clear all objects. Set vArr1 = Nothing Set vArr2 = Nothing End Function ' Speedy - copies using arrays. ' Copies remaining formulae down on the SHEETNAME1 sheet. Sub M10535_Copy_Post_SHEETNAME1_Formulae_Down_Array() Dim lastrow_CUST As Long Dim lastrow_SHEETNAME1 As Long Dim lastrow_FinalABC As Long Dim lastrow_HOLDINGS As Long Dim lastrow_MappingPivots As Long Dim lastrow_MappingPivots2 As Long Dim lastrow_MappingPivots3 As Long Dim lastrow_References As Long Dim lastrow_References_adjusted_rate As Long Dim lastrow_References_g3_location As Long Dim lastrow_References_income_type As Long Dim lastrow_References_allowed_locations As Long Dim lastrow_QSHEET As Long Dim lastrow_TRANSACTIONS As Long Dim lastrow_Wxxxx As Long Dim column_a As Variant Dim column_b As Variant Dim column_e As Variant Dim column_f As Variant Dim column_g As Variant Dim column_h As Variant Dim column_i As Variant Dim column_k As Variant Dim column_l As Variant Dim column_m As Variant Dim column_n As Variant Dim column_p As Variant Dim column_r As Variant Dim column_t As Variant Dim column_u As Variant Dim column_x As Variant Dim column_y As Variant Dim column_ab As Variant Dim column_ad As Variant Dim column_af As Variant Dim column_ai As Variant Dim column_aj As Variant Dim column_am As Variant Dim column_an As Variant Dim column_ao As Variant Dim column_aq As Variant Dim column_ar As Variant Dim column_au As Variant Dim column_aw As Variant Dim column_bb As Variant Dim column_bd As Variant Dim column_bh As Variant Dim column_a_CUST As Variant Dim column_b_CUST As Variant Dim column_a_FinalABC As Variant Dim column_d_FinalABC As Variant Dim column_k_FinalABC As Variant Dim column_n_FinalABC As Variant Dim column_a_HOLDINGS As Variant Dim column_f_HOLDINGS As Variant Dim column_a_MappingPivots As Variant Dim column_b_MappingPivots As Variant Dim column_c_MappingPivots As Variant Dim column_d_MappingPivots As Variant Dim column_f_MappingPivots As Variant Dim column_g_MappingPivots As Variant Dim column_h_MappingPivots As Variant Dim column_i_MappingPivots As Variant Dim column_k_MappingPivots As Variant Dim column_m_MappingPivots As Variant Dim column_a_QSHEET As Variant Dim column_a_References As Variant Dim column_b_References As Variant Dim column_h_References As Variant Dim column_i_References As Variant Dim column_j_References As Variant Dim column_k_References As Variant Dim column_o_References As Variant Dim column_p_References As Variant Dim column_q_References As Variant Dim column_s_References As Variant Dim column_u_References As Variant Dim column_ag_References As Variant Dim column_a_TRANSACTIONS As Variant Dim column_l_TRANSACTIONS As Variant Dim column_m_TRANSACTIONS As Variant Dim column_n_TRANSACTIONS As Variant Dim column_b_Wxxxx As Variant Dim column_y_Wxxxx As Variant Dim column_z_Wxxxx As Variant Dim prev_a As Variant Dim prev_b As Variant Dim prev_c As Variant Dim prev_d As Variant Dim prev_f As Variant Dim prev_g As Variant Dim prev_h As Variant Dim prev_i As Variant Dim tmp As Variant Dim working As Variant Dim n As Long ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Copy Post SHEETNAME1 formulae down?", vbYesNo) = vbNo Then Exit Sub End If ' Update StatusBar. Application.StatusBar = "Copy post-SHEETNAME1 Formulae down..." With Workbooks(wb_name) With .Sheets("SHEETNAME1") ' Activate the SHEETNAME1 sheet. .Activate ' Get how many rows of data have been loaded into the sheet. lastrow_SHEETNAME1 = .Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_SHEETNAME1 < 3 Then lastrow_SHEETNAME1 = 3 End If lastrow_CUST = Sheets("CUST").Cells(Rows.Count, 1).End(xlUp).Row lastrow_FinalABC = Sheets("FinalABC").Cells(Rows.Count, 4).End(xlUp).Row lastrow_HOLDINGS = Sheets("HOLDINGS").Cells(Rows.Count, 1).End(xlUp).Row lastrow_MappingPivots = Sheets("Mapping Pivots").Cells(Rows.Count, 1).End(xlUp).Row lastrow_MappingPivots2 = Sheets("Mapping Pivots").Cells(Rows.Count, 6).End(xlUp).Row lastrow_MappingPivots3 = Sheets("Mapping Pivots").Cells(Rows.Count, 11).End(xlUp).Row lastrow_References = Sheets("References").Cells(Rows.Count, 1).End(xlUp).Row lastrow_References_adjusted_rate = Sheets("References").Cells(Rows.Count, 8).End(xlUp).Row lastrow_References_g3_location = Sheets("References").Cells(Rows.Count, 15).End(xlUp).Row lastrow_References_income_type = Sheets("References").Cells(Rows.Count, 19).End(xlUp).Row lastrow_References_allowed_locations = Sheets("References").Cells(Rows.Count, 33).End(xlUp).Row lastrow_QSHEET = Sheets("QSHEET").Cells(Rows.Count, 1).End(xlUp).Row lastrow_TRANSACTIONS = Sheets("TRANSACTIONS").Cells(Rows.Count, 1).End(xlUp).Row lastrow_Wxxxx = Sheets("Wxxxx").Cells(Rows.Count, 2).End(xlUp).Row ReDim working(1 To lastrow_SHEETNAME1, 1) ' Working array working = Range("D3:D" & lastrow_SHEETNAME1) ' load with dummy values. ReDim column_a(1 To lastrow_SHEETNAME1, 1) ReDim column_b(1 To lastrow_SHEETNAME1, 1) ReDim column_e(1 To lastrow_SHEETNAME1, 1) ReDim column_f(1 To lastrow_SHEETNAME1, 1) ReDim column_g(1 To lastrow_SHEETNAME1, 1) ReDim column_h(1 To lastrow_SHEETNAME1, 1) ReDim column_i(1 To lastrow_SHEETNAME1, 1) ReDim column_k(1 To lastrow_SHEETNAME1, 1) ReDim column_l(1 To lastrow_SHEETNAME1, 1) ReDim column_m(1 To lastrow_SHEETNAME1, 1) ReDim column_n(1 To lastrow_SHEETNAME1, 1) ReDim column_p(1 To lastrow_SHEETNAME1, 1) ReDim column_r(1 To lastrow_SHEETNAME1, 1) ReDim column_t(1 To lastrow_SHEETNAME1, 1) ReDim column_u(1 To lastrow_SHEETNAME1, 1) ReDim column_x(1 To lastrow_SHEETNAME1, 1) ReDim column_y(1 To lastrow_SHEETNAME1, 1) ReDim column_ab(1 To lastrow_SHEETNAME1, 1) ReDim column_ad(1 To lastrow_SHEETNAME1, 1) ReDim column_af(1 To lastrow_SHEETNAME1, 1) ReDim column_ai(1 To lastrow_SHEETNAME1, 1) ReDim column_aj(1 To lastrow_SHEETNAME1, 1) ReDim column_am(1 To lastrow_SHEETNAME1, 1) ReDim column_an(1 To lastrow_SHEETNAME1, 1) ReDim column_ao(1 To lastrow_SHEETNAME1, 1) ReDim column_aq(1 To lastrow_SHEETNAME1, 1) ReDim column_ar(1 To lastrow_SHEETNAME1, 1) ReDim column_au(1 To lastrow_SHEETNAME1, 1) ReDim column_aw(1 To lastrow_SHEETNAME1, 1) ReDim column_bd(1 To lastrow_SHEETNAME1, 1) ReDim column_bh(1 To lastrow_SHEETNAME1, 1) ReDim column_a_CUST(1 To lastrow_CUST, 1) ReDim column_b_CUST(1 To lastrow_CUST, 1) ReDim column_a_FinalABC(1 To lastrow_FinalABC, 1) ReDim column_d_FinalABC(1 To lastrow_FinalABC, 1) ReDim column_k_FinalABC(1 To lastrow_FinalABC, 1) ReDim column_n_FinalABC(1 To lastrow_FinalABC, 1) ReDim column_a_HOLDINGS(1 To lastrow_HOLDINGS, 1) ReDim column_f_HOLDINGS(1 To lastrow_HOLDINGS, 1) ReDim column_a_MappingPivots(1 To lastrow_MappingPivots, 1) ReDim column_b_MappingPivots(1 To lastrow_MappingPivots, 1) ReDim column_c_MappingPivots(1 To lastrow_MappingPivots, 1) ReDim column_d_MappingPivots(1 To lastrow_MappingPivots, 1) ReDim column_f_MappingPivots(1 To lastrow_MappingPivots, 1) ReDim column_g_MappingPivots(1 To lastrow_MappingPivots, 1) ReDim column_h_MappingPivots(1 To lastrow_MappingPivots, 1) ReDim column_i_MappingPivots(1 To lastrow_MappingPivots, 1) ReDim column_m_MappingPivots(1 To lastrow_MappingPivots, 1) ReDim column_k_MappingPivots(1 To lastrow_MappingPivots, 1) ReDim column_a_References(1 To lastrow_References, 1) ReDim column_b_References(1 To lastrow_References, 1) ReDim column_h_References(1 To lastrow_References, 1) ReDim column_i_References(1 To lastrow_References, 1) ReDim column_j_References(1 To lastrow_References, 1) ReDim column_k_References(1 To lastrow_References, 1) ReDim column_o_References(1 To lastrow_References, 1) ReDim column_p_References(1 To lastrow_References, 1) ReDim column_q_References(1 To lastrow_References, 1) ReDim column_s_References(1 To lastrow_References, 1) ReDim column_u_References(1 To lastrow_References, 1) ReDim column_ag_References(1 To lastrow_References, 1) ReDim column_a_QSHEET(1 To lastrow_QSHEET, 1) ReDim column_a_TRANSACTIONS(1 To lastrow_TRANSACTIONS, 1) ReDim column_l_TRANSACTIONS(1 To lastrow_TRANSACTIONS, 1) ReDim column_m_TRANSACTIONS(1 To lastrow_TRANSACTIONS, 1) ReDim column_n_TRANSACTIONS(1 To lastrow_TRANSACTIONS, 1) ReDim column_b_Wxxxx(1 To lastrow_Wxxxx, 1) ReDim column_y_Wxxxx(1 To lastrow_Wxxxx, 1) ReDim column_z_Wxxxx(1 To lastrow_Wxxxx, 1) ' Column F ' =IF(X2="EXCLUDE",0,G2) column_g = Range("G3:G" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) For n = LBound(working) To UBound(working) If (column_y(n, 1) = "EXCLUDE") Then working(n, 1) = 0 Else working(n, 1) = column_g(n, 1) End If Next n .Range("F3:F" & lastrow_SHEETNAME1).Value = working ' Column H ' =G2-I2 column_g = Range("G3:G" & lastrow_SHEETNAME1) column_i = Range("I3:I" & lastrow_SHEETNAME1) For n = LBound(working) To UBound(working) working(n, 1) = column_g(n, 1) - column_i(n, 1) Next n .Range("H3:H" & lastrow_SHEETNAME1).Value = working ' Column J ' =IF(K2="",I2,IF(L2="",I2,IF(OR(L2=0,K2=0),0,I2/(L2/K2)))) column_k = Range("K3:K" & lastrow_SHEETNAME1) column_i = Range("I3:I" & lastrow_SHEETNAME1) column_l = Range("L3:L" & lastrow_SHEETNAME1) For n = LBound(working) To UBound(working) If column_k(n, 1) = "" Or column_k(n, 1) = 0 Then working(n, 1) = column_i(n, 1) Else If column_l(n, 1) = "" Or column_l(n, 1) = 0 Then working(n, 1) = column_i(n, 1) Else working(n, 1) = column_i(n, 1) / (column_l(n, 1) / column_k(n, 1)) End If End If Next n .Range("J3:J" & lastrow_SHEETNAME1).Value = working ' Column L ' =IF(G2=0,0,I2/G2) column_g = Range("G3:G" & lastrow_SHEETNAME1) column_i = Range("I3:I" & lastrow_SHEETNAME1) For n = LBound(working) To UBound(working) If column_g(n, 1) = 0 Then ' Cant SHEETNAME1de by zero. working(n, 1) = 0 Else working(n, 1) = column_i(n, 1) / column_g(n, 1) End If Next n .Range("L3:L" & lastrow_SHEETNAME1).Value = working ' Column M ' =VLOOKUP(U2,References!A$1:B$198,2,FALSE) column_a_References = Sheets("References").Range("A3:A" & lastrow_References) column_u = Range("U3:U" & lastrow_SHEETNAME1) column_b_References = Sheets("References").Range("B3:B" & lastrow_References) For n = LBound(working) To UBound(working) working(n, 1) = ArrayFind(column_a_References, column_u(n, 1), column_b_References, 0) Next n .Range("M3:M" & lastrow_SHEETNAME1).Value = working ' Column T ' =VLOOKUP(R2,CUST!$A$1:$B$26608,2,FALSE) column_r = Range("R3:R" & lastrow_SHEETNAME1) column_a_CUST = Sheets("CUST").Range("A3:A" & lastrow_CUST) column_b_CUST = Sheets("CUST").Range("B3:B" & lastrow_CUST) For n = LBound(working) To UBound(working) working(n, 1) = ArrayFind(column_a_CUST, column_r(n, 1), column_b_CUST, "") Next n .Range("T3:T" & lastrow_SHEETNAME1).Value = working ' Column V ' =IF(ISNA(VLOOKUP(B2,FinalABC!$D$1:$D$2227,1,FALSE)),"NON EXIST","EXIST") column_b = Range("B3:B" & lastrow_SHEETNAME1) column_d_FinalABC = Sheets("FinalABC").Range("D3:D" & lastrow_FinalABC) For n = LBound(working) To UBound(working) working(n, 1) = ArrayFindEx(column_d_FinalABC, column_b(n, 1), "EXIST", "NON EXIST") Next n .Range("V3:V" & lastrow_SHEETNAME1).Value = working ' Column W ' =B2=B1 .Range("W2:W2").AutoFill Destination:=.Range("W2:W" & lastrow_SHEETNAME1) .Range("W2:W" & lastrow_SHEETNAME1).Calculate .Range("W3:W" & lastrow_SHEETNAME1) = .Range("W3:W" & lastrow_SHEETNAME1).Value ' For n = LBound(working) To UBound(working) ' If (n > 1) Then ' working(n, 1) = column_b(n, 1) = column_b(n - 1, 1) ' End If ' Next n ' .range("W3:W" & lastrow_SHEETNAME1).Value = working ' Column X ' =IF(ISNA(VLOOKUP(A2,FinalABC!A$1:A$2227,1,FALSE)),"NON EXIST","EXIST") column_a = Range("A3:A" & lastrow_SHEETNAME1) column_a_FinalABC = Sheets("FinalABC").Range("A3:A" & lastrow_FinalABC) For n = LBound(working) To UBound(working) working(n, 1) = ArrayFindEx(column_a_FinalABC, column_a(n, 1), "EXIST", "NON EXIST") Next n .Range("X3:X" & lastrow_SHEETNAME1).Value = working ' Column AB ' =IF(OR(X2="NON EXIST",Y2="EXCLUDE"),"NON REPORTABLE",A2&" - "&ROUND(F2,0)) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_a = Range("A3:A" & lastrow_SHEETNAME1) column_f = Range("F3:F" & lastrow_SHEETNAME1) For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then working(n, 1) = "NON REPORTABLE" Else working(n, 1) = column_a(n, 1) & " - " & Round(column_f(n, 1), 0) End If Next n .Range("AB3:AB" & lastrow_SHEETNAME1).Value = working ' Column AC ' =IF(OR($X2="NON EXIST",$Y2="EXCLUDE"),"NON REPORTABLE",IFERROR(VLOOKUP($A2,'Mapping Pivots'!$A$4:$B$1458,2,FALSE), IFERROR(VLOOKUP($AB2,'Mapping Pivots'!$F$4:$G$2230,2,FALSE), "MANUAL INPUT"))) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_a = Range("A3:A" & lastrow_SHEETNAME1) column_ab = Range("AB3:AB" & lastrow_SHEETNAME1) column_a_MappingPivots = Sheets("Mapping Pivots").Range("A4:A" & lastrow_MappingPivots) column_b_MappingPivots = Sheets("Mapping Pivots").Range("B4:B" & lastrow_MappingPivots) column_f_MappingPivots = Sheets("Mapping Pivots").Range("F4:F" & lastrow_MappingPivots2) column_g_MappingPivots = Sheets("Mapping Pivots").Range("G4:G" & lastrow_MappingPivots2) ' Tidy up for Mapping Pivots columns. Often they are Empty when reporting a 2nd line for same key value. ' This effects binary searches, so initially in the columns if a blank is encountered then actual value ' is written in its place. prev_a = column_a_MappingPivots(LBound(column_a_MappingPivots), 1) prev_b = column_b_MappingPivots(LBound(column_b_MappingPivots), 1) For n = LBound(column_a_MappingPivots) To UBound(column_a_MappingPivots) If column_a_MappingPivots(n, 1) = "" Then column_a_MappingPivots(n, 1) = prev_a End If If column_b_MappingPivots(n, 1) = "" Then column_b_MappingPivots(n, 1) = prev_b End If prev_a = column_a_MappingPivots(n, 1) prev_b = column_b_MappingPivots(n, 1) Next n prev_f = column_f_MappingPivots(LBound(column_f_MappingPivots), 1) prev_g = column_g_MappingPivots(LBound(column_g_MappingPivots), 1) For n = LBound(column_f_MappingPivots) To UBound(column_f_MappingPivots) If column_f_MappingPivots(n, 1) = "" Then column_f_MappingPivots(n, 1) = prev_f End If If column_g_MappingPivots(n, 1) = "" Then column_g_MappingPivots(n, 1) = prev_g End If prev_f = column_f_MappingPivots(n, 1) prev_g = column_g_MappingPivots(n, 1) Next n For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then working(n, 1) = "NON REPORTABLE" Else If ArrayCountIf(column_a_MappingPivots, column_a(n, 1)) > 0 Then working(n, 1) = ArrayFind(column_a_MappingPivots, column_a(n, 1), column_b_MappingPivots, 0) Else If ArrayCountIf(column_f_MappingPivots, column_ab(n, 1)) > 0 Then working(n, 1) = ArrayFind(column_f_MappingPivots, column_ab(n, 1), column_g_MappingPivots, 0) Else working(n, 1) = "MANUAL INPUT" End If End If End If Next n .Range("AC3:AC" & lastrow_SHEETNAME1).Value = working ' .Range("AC2:AC2").AutoFill Destination:=.Range("AC2:AC" & lastrow_SHEETNAME1) ' .Range("AC2:AC" & lastrow_SHEETNAME1).Calculate ' .Range("AC3:AC" & lastrow_SHEETNAME1) = .Range("AC3:AC" & lastrow_SHEETNAME1).Value ' Column AE ' =IF(OR($X2="NON EXIST",$Y2="EXCLUDE"),"NON REPORTABLE",IFERROR(VLOOKUP($A2,'Mapping Pivots'!$A$4:$C$1458,3,FALSE),IFERROR(VLOOKUP($AB2,'Mapping Pivots'!$F$4:$H$2230,3,FALSE), "MANUAL INPUT"))) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_a = Range("A3:A" & lastrow_SHEETNAME1) column_ab = Range("AB3:AB" & lastrow_SHEETNAME1) column_a_MappingPivots = Sheets("Mapping Pivots").Range("A4:A" & lastrow_MappingPivots) column_c_MappingPivots = Sheets("Mapping Pivots").Range("C4:C" & lastrow_MappingPivots) column_f_MappingPivots = Sheets("Mapping Pivots").Range("F4:F" & lastrow_MappingPivots2) column_h_MappingPivots = Sheets("Mapping Pivots").Range("H4:H" & lastrow_MappingPivots2) ' Tidy up for Mapping Pivots columns. Often they are Empty when reporting a 2nd line for same key value. ' This effects binary searches, so initially in the columns if a blank is encountered then actual value ' is written in its place. prev_a = column_a_MappingPivots(LBound(column_a_MappingPivots), 1) prev_c = column_c_MappingPivots(LBound(column_c_MappingPivots), 1) For n = LBound(column_a_MappingPivots) To UBound(column_a_MappingPivots) If column_a_MappingPivots(n, 1) = "" Then column_a_MappingPivots(n, 1) = prev_a End If If column_c_MappingPivots(n, 1) = "" Then column_c_MappingPivots(n, 1) = prev_c End If prev_a = column_a_MappingPivots(n, 1) prev_c = column_c_MappingPivots(n, 1) Next n prev_f = column_f_MappingPivots(LBound(column_f_MappingPivots), 1) prev_h = column_h_MappingPivots(LBound(column_h_MappingPivots), 1) For n = LBound(column_f_MappingPivots) To UBound(column_f_MappingPivots) If column_f_MappingPivots(n, 1) = "" Then column_f_MappingPivots(n, 1) = prev_f End If If column_h_MappingPivots(n, 1) = "" Then column_h_MappingPivots(n, 1) = prev_h End If prev_f = column_f_MappingPivots(n, 1) prev_h = column_h_MappingPivots(n, 1) Next n For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then working(n, 1) = "NON REPORTABLE" Else If ArrayCountIf(column_a_MappingPivots, column_a(n, 1)) > 0 Then working(n, 1) = ArrayFind(column_a_MappingPivots, column_a(n, 1), column_c_MappingPivots, 0) Else If ArrayCountIf(column_f_MappingPivots, column_ab(n, 1)) > 0 Then working(n, 1) = ArrayFind(column_f_MappingPivots, column_ab(n, 1), column_h_MappingPivots, 0) Else working(n, 1) = "MANUAL INPUT" End If End If End If Next n .Range("AE3:AE" & lastrow_SHEETNAME1).Value = working ' Column AG ' =IF(OR($X2="NON EXIST",$Y2="EXCLUDE"),"NON REPORTABLE",IF(COUNTIF($A$1:A2,A2)>1,"AGGREGATE",ROUND(SUMIF($A$1:$A$52435,A2,$I$1:$I$52435)-SUMIF(FinalABC!$A$1:$A$2227,A2,FinalABC!$N$1:$N$2227),2))) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_a = Range("A3:A" & lastrow_SHEETNAME1) column_i = Range("I3:I" & lastrow_SHEETNAME1) column_a_FinalABC = Sheets("FinalABC").Range("A3:A" & lastrow_FinalABC) column_n_FinalABC = Sheets("FinalABC").Range("N3:N" & lastrow_FinalABC) For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then working(n, 1) = "NON REPORTABLE" Else If ArrayCountIf(column_a, column_a(n, 1)) > 1 Then working(n, 1) = "AGGREGATE" Else working(n, 1) = Round(ArraySumIf(column_a, column_a(n, 1), column_i) - ArraySumIf(column_a_FinalABC, column_a(n, 1), column_n_FinalABC), 2) End If End If Next n .Range("AG3:AG" & lastrow_SHEETNAME1).Value = working ' Column AH ' =IF(AG2="NON REPORTABLE",AG2,IF(AND(ROUND(SUMIFS($I$1:$I$52435,$A$1:$A$52435,A2,$Y$1:$Y$52435,"INCLUDE")-SUMIF(FinalABC!$A$1:$A$2227,A2,FinalABC!$N$1:$N$2227),2)>-1,ROUND(SUMIFS($I$1:$I$52435,$A$1:$A$52435,A2,$Y$1:$Y$52435,"INCLUDE")-SUMIF(FinalABC!$A$1:$A$2227,A2,FinalABC!$N$1:$N$2227),2)<1),K2,"MANUAL INPUT")) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_a = Range("A3:A" & lastrow_SHEETNAME1) column_i = Range("I3:I" & lastrow_SHEETNAME1) column_a_FinalABC = Sheets("FinalABC").Range("A3:A" & lastrow_FinalABC) column_n_FinalABC = Sheets("FinalABC").Range("N3:N" & lastrow_FinalABC) For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then 'If working(n, 1) = "NON REPORTABLE" Then working(n, 1) = "NON REPORTABLE" Else If (column_y(n, 1) = "INCLUDE") Then working(n, 1) = Round(ArraySumIf(column_a, column_a(n, 1), column_i) - ArraySumIf(column_a_FinalABC, column_a(n, 1), column_n_FinalABC), 2) If ((working(n, 1) > -1) Or (working(n, 1) < 1)) Then working(n, 1) = column_k(n, 1) Else working(n, 1) = "MANUAL INPUT" End If Else working(n, 1) = "MANUAL INPUT" End If End If Next n .Range("AH3:AH" & lastrow_SHEETNAME1).Value = working ' Copy adjustment data. 'zzzz .Range("AI2:AI" & lastrow_SHEETNAME1) = .Range("AH2:AH" & lastrow_SHEETNAME1).Value ' Column AJ ' =IF(OR($X2="NON EXIST",$Y2="EXCLUDE"),"NON REPORTABLE",ROUND(E2*SUM(AI2/100),2)) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_e = Range("E3:E" & lastrow_SHEETNAME1) column_ai = Range("AI3:AI" & lastrow_SHEETNAME1) For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then working(n, 1) = "NON REPORTABLE" Else If IsNumeric(column_ai(n, 1)) Then ' To cater for "Manual Input" in column AH. working(n, 1) = Round(column_e(n, 1) * column_ai(n, 1) / 100, 2) Else working(n, 1) = 0 End If End If Next n .Range("AJ3:AJ" & lastrow_SHEETNAME1).Value = working ' Column AK ' =IF(OR($X2="NON EXIST",$Y2="EXCLUDE"),"NON REPORTABLE",SUMIF($A$1:$A$52435,A2,$AJ$1:$AJ$52435)-SUMIF(FinalABC!$A$1:$A$2227,A2,FinalABC!$N$1:$N$2227)) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_a = Range("A3:A" & lastrow_SHEETNAME1) column_aj = Range("AJ3:AJ" & lastrow_SHEETNAME1) column_a_FinalABC = Sheets("FinalABC").Range("A3:A" & lastrow_FinalABC) column_n_FinalABC = Sheets("FinalABC").Range("N3:N" & lastrow_FinalABC) For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then working(n, 1) = "NON REPORTABLE" Else 'working(n, 1) = Round(ArraySumIf(column_a, column_a(n, 1), column_aj) - ArraySumIf(column_a_FinalABC, column_a(n, 1), column_n_FinalABC), 2) working(n, 1) = ArraySumIf(column_a, column_a(n, 1), column_aj) - ArraySumIf(column_a_FinalABC, column_a(n, 1), column_n_FinalABC) End If Next n .Range("AK3:AK" & lastrow_SHEETNAME1).Value = working ' Column AL ' =IF(OR($X2="NON EXIST",$Y2="EXCLUDE"), "NON REPORTABLE", IFERROR(VLOOKUP($A2,'Mapping Pivots'!$A$4:$D$1458,4,FALSE), IFERROR(VLOOKUP($AB2,'Mapping Pivots'!$F$4:$I$2230,4,FALSE), "MANUAL INPUT"))) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_a = Range("A3:A" & lastrow_SHEETNAME1) column_ab = Range("AB3:AB" & lastrow_SHEETNAME1) column_a_MappingPivots = Sheets("Mapping Pivots").Range("A4:A" & lastrow_MappingPivots) column_d_MappingPivots = Sheets("Mapping Pivots").Range("D4:D" & lastrow_MappingPivots) column_f_MappingPivots = Sheets("Mapping Pivots").Range("F4:F" & lastrow_MappingPivots2) column_i_MappingPivots = Sheets("Mapping Pivots").Range("I4:I" & lastrow_MappingPivots2) ' Tidy up for Mapping Pivots columns. Often they are Empty when reporting a 2nd line for same key value. ' This effects binary searches, so initially in the columns if a blank is encountered then actual value ' is written in its place. prev_a = column_a_MappingPivots(LBound(column_a_MappingPivots), 1) prev_d = column_d_MappingPivots(LBound(column_d_MappingPivots), 1) For n = LBound(column_a_MappingPivots) To UBound(column_a_MappingPivots) If column_a_MappingPivots(n, 1) = "" Then column_a_MappingPivots(n, 1) = prev_a End If If column_d_MappingPivots(n, 1) = "" Then column_d_MappingPivots(n, 1) = prev_d End If prev_a = column_a_MappingPivots(n, 1) prev_d = column_d_MappingPivots(n, 1) Next n prev_f = column_f_MappingPivots(LBound(column_f_MappingPivots), 1) prev_i = column_i_MappingPivots(LBound(column_i_MappingPivots), 1) For n = LBound(column_f_MappingPivots) To UBound(column_f_MappingPivots) If column_f_MappingPivots(n, 1) = "" Then column_f_MappingPivots(n, 1) = prev_f End If If column_i_MappingPivots(n, 1) = "" Then column_i_MappingPivots(n, 1) = prev_i End If prev_f = column_f_MappingPivots(n, 1) prev_i = column_i_MappingPivots(n, 1) Next n For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then working(n, 1) = "NON REPORTABLE" Else If ArrayCountIf(column_a_MappingPivots, column_a(n, 1)) > 0 Then working(n, 1) = ArrayFind(column_a_MappingPivots, column_a(n, 1), column_d_MappingPivots, 0) Else If ArrayCountIf(column_f_MappingPivots, column_ab(n, 1)) > 0 Then working(n, 1) = ArrayFind(column_f_MappingPivots, column_ab(n, 1), column_i_MappingPivots, 0) Else working(n, 1) = "MANUAL INPUT" End If End If End If Next n .Range("AL3:AL" & lastrow_SHEETNAME1).Value = working ' .Range("AL2:AL2").AutoFill Destination:=.Range("AL2:AL" & lastrow_SHEETNAME1) ' .Range("AL2:AL" & lastrow_SHEETNAME1).Calculate ' .Range("AL3:AL" & lastrow_SHEETNAME1) = .Range("AL3:AL" & lastrow_SHEETNAME1).Value ' Copy adjustment data. 'zzzz .Range("AM2:AM" & lastrow_SHEETNAME1) = .Range("AL2:AL" & lastrow_SHEETNAME1).Value ' Column AN ' =IF(OR($X2="NON EXIST",$Y2="EXCLUDE"),"NON REPORTABLE",IFERROR(VLOOKUP(A2&" - "&AM2,'Mapping Pivots'!$K$4:$M$1458,2,FALSE), 0)) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_a = Range("A3:A" & lastrow_SHEETNAME1) column_am = Range("AM3:AM" & lastrow_SHEETNAME1) column_k_MappingPivots = Sheets("Mapping Pivots").Range("K4:K" & lastrow_MappingPivots3) column_m_MappingPivots = Sheets("Mapping Pivots").Range("M4:M" & lastrow_MappingPivots3) For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then working(n, 1) = "NON REPORTABLE" Else working(n, 1) = ArrayFind(column_k_MappingPivots, column_a(n, 1) & " - " & column_am(n, 1), column_m_MappingPivots, 0) End If Next n .Range("AN3:AN" & lastrow_SHEETNAME1).Value = working ' .Range("AN2:AN2").AutoFill Destination:=.Range("AN2:AN" & lastrow_SHEETNAME1) ' .Range("AN2:AN" & lastrow_SHEETNAME1).Calculate ' .Range("AN3:AN" & lastrow_SHEETNAME1) = .Range("AN3:AN" & lastrow_SHEETNAME1).Value ' Column AO ' =IF(OR($X2="NON EXIST",$Y2="EXCLUDE"),"NON REPORTABLE",F2/AN2) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_f = Range("F3:F" & lastrow_SHEETNAME1) column_an = Range("AN3:AN" & lastrow_SHEETNAME1) For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then working(n, 1) = "NON REPORTABLE" Else If (column_an(n, 1) = 0) Then ' Can't SHEETNAME1de by zero. working(n, 1) = 0 Else working(n, 1) = column_f(n, 1) / column_an(n, 1) End If End If Next n .Range("AO3:AO" & lastrow_SHEETNAME1).Value = working ' Column AP ' =IF(OR($X2="NON EXIST",$Y2="EXCLUDE"),"NON REPORTABLE",IF(COUNTIF($A$1:A2,A2)>1,"AGGREGATE",SUMIF($A:$A,A2,$AO:$AO)-SUMIF(FinalABC!$A:$A,A2,FinalABC!$K:$K))) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_a = Range("A3:A" & lastrow_SHEETNAME1) column_ao = Range("AO3:AO" & lastrow_SHEETNAME1) column_a_FinalABC = Sheets("FinalABC").Range("A3:A" & lastrow_FinalABC) column_k_FinalABC = Sheets("FinalABC").Range("K3:K" & lastrow_FinalABC) For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then working(n, 1) = "NON REPORTABLE" Else If ArrayCountIf(column_a, column_a(n, 1)) > 1 Then working(n, 1) = "AGGREGATE" Else working(n, 1) = Round(ArraySumIf(column_a, column_a(n, 1), column_ao) - ArraySumIf(column_a_FinalABC, column_a(n, 1), column_k_FinalABC), 2) End If End If Next n .Range("AP3:AP" & lastrow_SHEETNAME1).Value = working ' Column AQ ' =IF(OR($X2="NON EXIST",$Y2="EXCLUDE"),"NON REPORTABLE",T2&" - "& IFERROR(IF(VLOOKUP(R2,Wxxxx!B:Z,24,FALSE)="YES", "VALID", "INVALID"),"INVALID")&" - " & IFERROR(VLOOKUP(R2,Wxxxx!B:Z,25,FALSE),"N") &" - "&K2) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_t = Range("T3:T" & lastrow_SHEETNAME1) column_u = Range("U3:U" & lastrow_SHEETNAME1) column_b_Wxxxx = Sheets("Wxxxx").Range("B3:B" & lastrow_Wxxxx) column_y_Wxxxx = Sheets("Wxxxx").Range("Y3:Y" & lastrow_Wxxxx) column_r = Range("R3:R" & lastrow_SHEETNAME1) column_z_Wxxxx = Sheets("Wxxxx").Range("Z3:Z" & lastrow_Wxxxx) column_k = Range("K3:K" & lastrow_SHEETNAME1) For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then working(n, 1) = "NON REPORTABLE" Else working(n, 1) = column_t(n, 1) & " - " tmp = ArrayFind(column_b_Wxxxx, column_r(n, 1), column_y_Wxxxx, 0) If tmp = "YES" Then working(n, 1) = working(n, 1) & "VALID" & " - " Else working(n, 1) = working(n, 1) & "INVALID" & " - " End If tmp = ArrayFind(column_b_Wxxxx, column_r(n, 1), column_z_Wxxxx, "N") working(n, 1) = working(n, 1) & tmp & " - " & column_k(n, 1) End If Next n .Range("AQ3:AQ" & lastrow_SHEETNAME1).Value = working ' .Range("AQ2:AQ2").AutoFill Destination:=.Range("AQ2:AQ" & lastrow_SHEETNAME1) ' .Range("AQ2:AQ" & lastrow_SHEETNAME1).Calculate ' .Range("AQ3:AQ" & lastrow_SHEETNAME1) = .Range("AQ3:AQ" & lastrow_SHEETNAME1).Value ' Column AR ' =IF(OR($X2="NON EXIST",$Y2="EXCLUDE"),"NON REPORTABLE",IFERROR(VLOOKUP(AQ2,References!$H$1:$K$45,2,FALSE),0)) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_aq = Range("AQ3:AQ" & lastrow_SHEETNAME1) column_h_References = Sheets("References").Range("H3:H" & lastrow_References_adjusted_rate) column_i_References = Sheets("References").Range("I3:I" & lastrow_References_adjusted_rate) For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then working(n, 1) = "NON REPORTABLE" Else working(n, 1) = ArrayFind(column_h_References, column_aq(n, 1), column_i_References, 0) End If Next n .Range("AR3:AR" & lastrow_SHEETNAME1).Value = working ' .Range("AR2:AR2").AutoFill Destination:=.Range("AR2:AR" & lastrow_SHEETNAME1) ' .Range("AR2:AR" & lastrow_SHEETNAME1).Calculate ' .Range("AR3:AR" & lastrow_SHEETNAME1) = .Range("AR3:AR" & lastrow_SHEETNAME1).Value ' Column AS ' =IF(OR($X2="NON EXIST",$Y2="EXCLUDE"),"NON REPORTABLE",IFERROR(VLOOKUP(AQ2,References!$H$1:$K$45,3,FALSE),0)) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_aq = Range("AQ3:AQ" & lastrow_SHEETNAME1) column_h_References = Sheets("References").Range("H3:H" & lastrow_References_adjusted_rate) column_j_References = Sheets("References").Range("J3:J" & lastrow_References_adjusted_rate) For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then working(n, 1) = "NON REPORTABLE" Else working(n, 1) = ArrayFind(column_h_References, column_aq(n, 1), column_j_References, 0) End If Next n .Range("AS3:AS" & lastrow_SHEETNAME1).Value = working ' .Range("AS2:AS2").AutoFill Destination:=.Range("AS2:AS" & lastrow_SHEETNAME1) ' .Range("AS2:AS" & lastrow_SHEETNAME1).Calculate ' .Range("AS3:AS" & lastrow_SHEETNAME1) = .Range("AS3:AS" & lastrow_SHEETNAME1).Value ' Column AT ' =IF(OR($X2="NON EXIST",$Y2="EXCLUDE"),"NON REPORTABLE",IFERROR(VLOOKUP(AQ2,References!$H$1:$K$45,4,FALSE),0)) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_aq = Range("AQ3:AQ" & lastrow_SHEETNAME1) column_h_References = Sheets("References").Range("H3:H" & lastrow_References_adjusted_rate) column_k_References = Sheets("References").Range("K3:K" & lastrow_References_adjusted_rate) For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then working(n, 1) = "NON REPORTABLE" Else working(n, 1) = ArrayFind(column_h_References, column_aq(n, 1), column_k_References, 0) End If Next n .Range("AT3:AT" & lastrow_SHEETNAME1).Value = working ' .Range("AT2:AT2").AutoFill Destination:=.Range("AT2:AT" & lastrow_SHEETNAME1) ' .Range("AT2:AT" & lastrow_SHEETNAME1).Calculate ' .Range("AT3:AT" & lastrow_SHEETNAME1) = .Range("AT3:AT" & lastrow_SHEETNAME1).Value ' Copy adjustment data. 'zzzz .Range("AU2:AU" & lastrow_SHEETNAME1) = .Range("AT2:AT" & lastrow_SHEETNAME1).Value ' Column AV ' =IF(OR($X2="NON EXIST",$Y2="EXCLUDE"),"NON REPORTABLE",IFERROR(VLOOKUP(AD2&" - "&AF2,References!S:W,3,FALSE),0)) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_ad = Range("AD3:AD" & lastrow_SHEETNAME1) column_af = Range("AF3:AF" & lastrow_SHEETNAME1) column_s_References = Sheets("References").Range("S3:S" & lastrow_References_income_type) column_u_References = Sheets("References").Range("U3:U" & lastrow_References_income_type) For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then working(n, 1) = "NON REPORTABLE" Else working(n, 1) = ArrayFind(column_s_References, column_ad(n, 1) & " - " & column_af(n, 1), column_u_References, 0) End If Next n .Range("AV3:AV" & lastrow_SHEETNAME1).Value = working ' .Range("AV2:AV2").AutoFill Destination:=.Range("AV2:AV" & lastrow_SHEETNAME1) ' .Range("AV2:AV" & lastrow_SHEETNAME1).Calculate ' .Range("AV3:AV" & lastrow_SHEETNAME1) = .Range("AV3:AV" & lastrow_SHEETNAME1).Value ' Column AW ' =IF(OR($X2="NON EXIST",$Y2="EXCLUDE"),"NON REPORTABLE",IF(OR(AR2="NO ADJUSTMENT REQUIRED",K2=AU2),"NO ADJUSTMENT REQUIRED","ADJUST FROM "&K2&"% TO "&AU2&"% - BBH REPORTED "&AI2&"%")) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_ar = Range("AR3:AR" & lastrow_SHEETNAME1) column_k = Range("K3:K" & lastrow_SHEETNAME1) column_au = Range("AU3:AU" & lastrow_SHEETNAME1) column_ai = Range("AI3:AI" & lastrow_SHEETNAME1) For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then working(n, 1) = "NON REPORTABLE" Else If (column_ar(n, 1) = "NO ADJUSTMENT REQUIRED" Or column_k(n, 1) = column_au(n, 1)) Then working(n, 1) = "NO ADJUSTMENT REQUIRED" Else working(n, 1) = "ADJUST FROM " & column_k(n, 1) & "% TO " & column_au(n, 1) & "% - BBH REPORTED " & column_ai(n, 1) & "%" End If End If Next n .Range("AW3:AW" & lastrow_SHEETNAME1).Value = working ' Column AX ' =IF(OR($X2="NON EXIST",$Y2="EXCLUDE"),"NON REPORTABLE",IF(R2=530572,"BPB&T IOM",IF(T2="IBGC","BPCI","BPB&T Jersey"))) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_r = Range("R3:R" & lastrow_SHEETNAME1) column_t = Range("T3:T" & lastrow_SHEETNAME1) For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then working(n, 1) = "NON REPORTABLE" Else If (column_r(n, 1) = 530572) Then working(n, 1) = "BPB&T IOM" Else If (column_t(n, 1) = "IBGC") Then working(n, 1) = "BPCI" Else working(n, 1) = "BPB&T Jersey" End If End If End If Next n .Range("AX3:AX" & lastrow_SHEETNAME1).Value = working ' Column AY ' =IF(AW2="NO ADJUSTMENT REQUIRED","NO ADJUSTMENT REQUIRED",IF(AW2="NON REPORTABLE","NON REPORTABLE",ROUND((F2*AU2%)-I2,2))) column_aw = Range("AW3:AW" & lastrow_SHEETNAME1) column_f = Range("F3:F" & lastrow_SHEETNAME1) column_au = Range("AU3:AU" & lastrow_SHEETNAME1) column_i = Range("I3:I" & lastrow_SHEETNAME1) For n = LBound(working) To UBound(working) If (column_aw(n, 1) = "NO ADJUSTMENT REQUIRED") Then working(n, 1) = "NO ADJUSTMENT REQUIRED" Else If (column_aw(n, 1) = "NON REPORTABLE") Then working(n, 1) = "NON REPORTABLE" Else working(n, 1) = Round((column_f(n, 1) * column_au(n, 1) / 100) - column_i(n, 1), 2) End If End If Next n .Range("AY3:AY" & lastrow_SHEETNAME1).Value = working ' Column BB ' =IF(ISNA(VLOOKUP(U2,References!$AG:$AG,1,FALSE)),"NO ADJUSTMENT REQUIRED",IF(AW2="NO ADJUSTMENT REQUIRED","NO ADJUSTMENT REQUIRED",IF(AW2="NON REPORTABLE","NON REPORTABLE",IFERROR(VLOOKUP(T2&" - "&AU2,References!$O$2:$Q$5,3,FALSE),0)))) column_u = Range("U3:U" & lastrow_SHEETNAME1) column_ag_References = Sheets("References").Range("AG3:AG" & lastrow_References_allowed_locations) column_aw = Range("AW3:AW" & lastrow_SHEETNAME1) column_t = Range("T3:T" & lastrow_SHEETNAME1) column_au = Range("AU3:AU" & lastrow_SHEETNAME1) column_o_References = Sheets("References").Range("O3:O" & lastrow_References_g3_location) column_q_References = Sheets("References").Range("Q3:Q" & lastrow_References_g3_location) For n = LBound(working) To UBound(working) If ArrayCountIf(column_ag_References, column_u(n, 1)) > 0 Then If column_aw(n, 1) = "NO ADJUSTMENT REQUIRED" Then working(n, 1) = "NO ADJUSTMENT REQUIRED" Else If column_aw(n, 1) = "NON REPORTABLE" Then working(n, 1) = "NON REPORTABLE" Else working(n, 1) = ArrayFind(column_o_References, column_t(n, 1) & " - " & column_au(n, 1), column_q_References, 0) End If End If 'working(n, 1) = Round(ArraySumIf(column_a, column_a(n, 1), column_an) - ArraySumIf(column_a_FinalABC, column_a(n, 1), column_k_FinalABC), 2) Else working(n, 1) = "NO ADJUSTMENT REQUIRED" End If Next n .Range("BB3:BB" & lastrow_SHEETNAME1).Value = working ' .Range("BB2:BB2").AutoFill Destination:=.Range("BB2:BB" & lastrow_SHEETNAME1) ' .Range("BB2:BB" & lastrow_SHEETNAME1).Calculate ' .Range("BB3:BB" & lastrow_SHEETNAME1) = .Range("BB3:BB" & lastrow_SHEETNAME1).Value ' Column BD ' =IF(AW2="NO ADJUSTMENT REQUIRED","NO ADJUSTMENT REQUIRED",IF(AW2="NON REPORTABLE","NON REPORTABLE",IFERROR(VLOOKUP(T2& " - " &AU2,References!$O$2:$Q$5,2,FALSE),0))) column_aw = Range("AW3:AW" & lastrow_SHEETNAME1) column_au = Range("AU3:AU" & lastrow_SHEETNAME1) column_o_References = Sheets("References").Range("O3:O" & lastrow_References_g3_location) column_p_References = Sheets("References").Range("P3:P" & lastrow_References_g3_location) For n = LBound(working) To UBound(working) If (column_aw(n, 1) = "NO ADJUSTMENT REQUIRED") Then working(n, 1) = "NO ADJUSTMENT REQUIRED" Else If (column_aw(n, 1) = "NON REPORTABLE") Then working(n, 1) = "NON REPORTABLE" Else working(n, 1) = ArrayFind(column_o_References, column_t(n, 1) & " - " & column_au(n, 1), column_p_References, 0) End If End If Next n .Range("BD3:BD" & lastrow_SHEETNAME1).Value = working ' .Range("BD2:BD2").AutoFill Destination:=.Range("BD2:BD" & lastrow_SHEETNAME1) ' .Range("BD2:BD" & lastrow_SHEETNAME1).Calculate ' .Range("BD3:BD" & lastrow_SHEETNAME1) = .Range("BD3:BD" & lastrow_SHEETNAME1).Value ' Column BE '=IF(AW2="NO ADJUSTMENT REQUIRED","NO ADJUSTMENT REQUIRED",IF(AW2="NON REPORTABLE","NON REPORTABLE",IF(BD2<>M2,"Yes","No"))) column_aw = Range("AW3:AW" & lastrow_SHEETNAME1) column_bd = Range("BD3:BD" & lastrow_SHEETNAME1) column_m = Range("M3:M" & lastrow_SHEETNAME1) For n = LBound(working) To UBound(working) If (column_aw(n, 1) = "NO ADJUSTMENT REQUIRED") Then working(n, 1) = "NO ADJUSTMENT REQUIRED" Else If (column_aw(n, 1) = "NON REPORTABLE") Then working(n, 1) = "NON REPORTABLE" Else If (column_bd(n, 1) <> column_m(n, 1)) Then working(n, 1) = "Yes" Else working(n, 1) = "No" End If End If End If Next n .Range("BE3:BE" & lastrow_SHEETNAME1).Value = working ' Column BG ' =IF(ISNA(VLOOKUP(R2&N2,HOLDINGS!A:A,1,FALSE)),"NO HOLDINGS","STILL HAS HOLDINGS") column_r = Range("R3:R" & lastrow_SHEETNAME1) column_n = Range("N3:N" & lastrow_SHEETNAME1) column_a_HOLDINGS = Sheets("HOLDINGS").Range("A3:A" & lastrow_HOLDINGS) For n = LBound(working) To UBound(working) 'working(n, 1) = ArrayFind(column_a_HOLDINGS, column_r(n, 1) & column_n(n, 1), column_a_HOLDINGS, 0) working(n, 1) = ArrayFindEx(column_a_HOLDINGS, column_r(n, 1) & column_n(n, 1), "STILL HAS HOLDINGS", "NO HOLDINGS") Next n .Range("BG3:BG" & lastrow_SHEETNAME1).Value = working ' .Range("BG2:BG2").AutoFill Destination:=.Range("BF2:BF" & lastrow_SHEETNAME1) ' .Range("BG2:BG" & lastrow_SHEETNAME1).Calculate ' .Range("BG3:BG" & lastrow_SHEETNAME1) = .Range("BF3:BF" & lastrow_SHEETNAME1).Value ' Column BH '=IF(ISNA(VLOOKUP(R2&N2,HOLDINGS!A:G,7,FALSE)),"NO HOLDINGS",VLOOKUP(R2&N2,HOLDINGS!A:G,7,FALSE)) column_r = Range("R3:R" & lastrow_SHEETNAME1) column_n = Range("N3:N" & lastrow_SHEETNAME1) column_a_HOLDINGS = Sheets("HOLDINGS").Range("A3:A" & lastrow_HOLDINGS) column_f_HOLDINGS = Sheets("HOLDINGS").Range("F3:F" & lastrow_HOLDINGS) For n = LBound(working) To UBound(working) working(n, 1) = ArrayFind(column_a_HOLDINGS, column_r(n, 1) & column_n(n, 1), column_f_HOLDINGS, "NO HOLDINGS") Next n .Range("BH3:BH" & lastrow_SHEETNAME1).Value = working ' .Range("BH2:BH2").AutoFill Destination:=.Range("BH2:BH" & lastrow_SHEETNAME1) ' .Range("BH2:BH" & lastrow_SHEETNAME1).Calculate ' .Range("BH3:BH" & lastrow_SHEETNAME1) = .Range("BH3:BH" & lastrow_SHEETNAME1).Value ' Column BI ' =IF(BH2="NO HOLDINGS","NO HOLDINGS",VLOOKUP(BH2,References!A:B,2,FALSE)) column_bh = Range("BH3:BH" & lastrow_SHEETNAME1) column_a_References = Sheets("References").Range("A3:A" & lastrow_References) column_b_References = Sheets("References").Range("B3:B" & lastrow_References) For n = LBound(working) To UBound(working) If column_bh(n, 1) = "NO HOLDINGS" Then working(n, 1) = "NO HOLDINGS" Else working(n, 1) = ArrayFind(column_a_References, column_bh(n, 1), column_b_References, 0) End If Next n .Range("BI3:BI" & lastrow_SHEETNAME1).Value = working ' .Range("BI2:BI2").AutoFill Destination:=.Range("BI2:BI" & lastrow_SHEETNAME1) ' .Range("BI2:BI" & lastrow_SHEETNAME1).Calculate ' .Range("BI3:BI" & lastrow_SHEETNAME1) = .Range("BI3:BI" & lastrow_SHEETNAME1).Value ' Column BJ ' =IF(OR(BB2="NO ADJUSTMENT REQUIRED",Y2="EXCLUDE"),"NO ADJUSTMENT REQUIRED",IFERROR(VLOOKUP(LEFT(P2,6)&TEXT(H2,"#.00")&R2,TRANSACTIONS!A:L,12,FALSE),0)) column_bb = Range("BB3:BB" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_p = Range("P3:P" & lastrow_SHEETNAME1) column_h = Range("H3:H" & lastrow_SHEETNAME1) column_r = Range("R3:R" & lastrow_SHEETNAME1) column_a_TRANSACTIONS = Sheets("TRANSACTIONS").Range("A3:A" & lastrow_TRANSACTIONS) column_l_TRANSACTIONS = Sheets("TRANSACTIONS").Range("L3:L" & lastrow_TRANSACTIONS) For n = LBound(working) To UBound(working) If column_bb(n, 1) = "NO ADJUSTMENT REQUIRED" Or column_y(n, 1) = "EXCLUDE" Then working(n, 1) = "NO ADJUSTMENT REQUIRED" Else working(n, 1) = ArrayFind(column_a_TRANSACTIONS, Left(column_p(n, 1), 6) & WorksheetFunction.Text(column_h(n, 1), "#.00") & column_r(n, 1), column_l_TRANSACTIONS, 0) End If Next n .Range("BJ3:BJ" & lastrow_SHEETNAME1).Value = working ' .Range("BJ2:BJ2").AutoFill Destination:=.Range("BJ2:BJ" & lastrow_SHEETNAME1) ' .Range("BJ2:BJ" & lastrow_SHEETNAME1).Calculate ' .Range("BJ3:BJ" & lastrow_SHEETNAME1) = .Range("BJ3:BJ" & lastrow_SHEETNAME1).Value ' Column BK ' =IF(OR(BB2="NO ADJUSTMENT REQUIRED",Y2="EXCLUDE"),"NO ADJUSTMENT REQUIRED",VLOOKUP(LEFT(P2,6)&Text(H2,"#.00")&R2,TRANSACTIONS!A:M,13,FALSE)) column_bb = Range("BB3:BB" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_p = Range("P3:P" & lastrow_SHEETNAME1) column_h = Range("H3:H" & lastrow_SHEETNAME1) column_r = Range("R3:R" & lastrow_SHEETNAME1) column_a_TRANSACTIONS = Sheets("TRANSACTIONS").Range("A3:A" & lastrow_TRANSACTIONS) column_m_TRANSACTIONS = Sheets("TRANSACTIONS").Range("M3:M" & lastrow_TRANSACTIONS) For n = LBound(working) To UBound(working) If column_bb(n, 1) = "NO ADJUSTMENT REQUIRED" Or column_y(n, 1) = "EXCLUDE" Then working(n, 1) = "NO ADJUSTMENT REQUIRED" Else working(n, 1) = ArrayFind(column_a_TRANSACTIONS, Left(column_p(n, 1), 6) & WorksheetFunction.Text(column_h(n, 1), "#.00") & column_r(n, 1), column_m_TRANSACTIONS, 0) End If Next n .Range("BK3:BK" & lastrow_SHEETNAME1).Value = working ' .Range("BK2:BK2").AutoFill Destination:=.Range("BK2:BK" & lastrow_SHEETNAME1) ' .Range("BK2:BK" & lastrow_SHEETNAME1).Calculate ' .Range("BK3:BK" & lastrow_SHEETNAME1) = .Range("BK3:BK" & lastrow_SHEETNAME1).Value ' Column BL ' =IF(OR(BB2="NO ADJUSTMENT REQUIRED",Y2="EXCLUDE"),"NO ADJUSTMENT REQUIRED",VLOOKUP(LEFT(P2,6)&Text(H2,"#.00")&R2,TRANSACTIONS!A:N,14,FALSE)) column_bb = Range("BB3:BB" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_p = Range("P3:P" & lastrow_SHEETNAME1) column_h = Range("H3:H" & lastrow_SHEETNAME1) column_r = Range("R3:R" & lastrow_SHEETNAME1) column_a_TRANSACTIONS = Sheets("TRANSACTIONS").Range("A3:A" & lastrow_TRANSACTIONS) column_n_TRANSACTIONS = Sheets("TRANSACTIONS").Range("N3:N" & lastrow_TRANSACTIONS) For n = LBound(working) To UBound(working) If column_bb(n, 1) = "NO ADJUSTMENT REQUIRED" Or column_y(n, 1) = "EXCLUDE" Then working(n, 1) = "NO ADJUSTMENT REQUIRED" Else working(n, 1) = ArrayFind(column_a_TRANSACTIONS, Left(column_p(n, 1), 6) & WorksheetFunction.Text(column_h(n, 1), "#.00") & column_r(n, 1), column_n_TRANSACTIONS, 0) End If Next n .Range("BL3:BL" & lastrow_SHEETNAME1).Value = working ' .Range("BL2:BL2").AutoFill Destination:=.Range("BL2:BL" & lastrow_SHEETNAME1) ' .Range("BL2:BL" & lastrow_SHEETNAME1).Calculate ' .Range("BL3:BL" & lastrow_SHEETNAME1) = .Range("BL3:BL" & lastrow_SHEETNAME1).Value ' Column BM ' =IF(ISNA(VLOOKUP(R2,QSHEET!A:A,1,FALSE)),"NOT ON QSHEET", "ON QSHEET") column_r = Range("R3:R" & lastrow_SHEETNAME1) column_a_QSHEET = Sheets("QSHEET").Range("A3:A" & lastrow_QSHEET) For n = LBound(working) To UBound(working) working(n, 1) = ArrayFindEx(column_a_QSHEET, column_r(n, 1), "ON QSHEET", "NOT ON QSHEET") Next n .Range("BM3:BM" & lastrow_SHEETNAME1).Value = working ' .Range("BM2:BM2").AutoFill Destination:=.Range("BM2:BM" & lastrow_SHEETNAME1) ' .Range("BM2:BM" & lastrow_SHEETNAME1).Calculate ' .Range("BM3:BM" & lastrow_SHEETNAME1) = .Range("BM3:BM" & lastrow_SHEETNAME1).Value End With End With ' Clear all objects. Set working = Nothing Set column_a = Nothing Set column_b = Nothing Set column_e = Nothing Set column_f = Nothing Set column_g = Nothing Set column_h = Nothing Set column_i = Nothing Set column_k = Nothing Set column_l = Nothing Set column_m = Nothing Set column_n = Nothing Set column_p = Nothing Set column_r = Nothing Set column_t = Nothing Set column_u = Nothing Set column_x = Nothing Set column_y = Nothing Set column_ab = Nothing Set column_ad = Nothing Set column_af = Nothing Set column_ai = Nothing Set column_aj = Nothing Set column_am = Nothing Set column_an = Nothing Set column_ao = Nothing Set column_aq = Nothing Set column_ar = Nothing Set column_au = Nothing Set column_aw = Nothing Set column_bb = Nothing Set column_bd = Nothing Set column_bh = Nothing Set column_a_CUST = Nothing Set column_b_CUST = Nothing Set column_a_FinalABC = Nothing Set column_d_FinalABC = Nothing Set column_k_FinalABC = Nothing Set column_n_FinalABC = Nothing Set column_a_HOLDINGS = Nothing Set column_f_HOLDINGS = Nothing Set column_a_MappingPivots = Nothing Set column_b_MappingPivots = Nothing Set column_c_MappingPivots = Nothing Set column_d_MappingPivots = Nothing Set column_f_MappingPivots = Nothing Set column_g_MappingPivots = Nothing Set column_h_MappingPivots = Nothing Set column_i_MappingPivots = Nothing Set column_k_MappingPivots = Nothing Set column_m_MappingPivots = Nothing Set column_a_QSHEET = Nothing Set column_a_References = Nothing Set column_b_References = Nothing Set column_h_References = Nothing Set column_i_References = Nothing Set column_j_References = Nothing Set column_k_References = Nothing Set column_o_References = Nothing Set column_p_References = Nothing Set column_q_References = Nothing Set column_s_References = Nothing Set column_u_References = Nothing Set column_ag_References = Nothing Set column_a_TRANSACTIONS = Nothing Set column_l_TRANSACTIONS = Nothing Set column_m_TRANSACTIONS = Nothing Set column_n_TRANSACTIONS = Nothing Set column_b_Wxxxx = Nothing Set column_y_Wxxxx = Nothing Set column_z_Wxxxx = Nothing Set prev_a = Nothing Set prev_b = Nothing Set prev_c = Nothing Set prev_f = Nothing Set prev_g = Nothing Set prev_h = Nothing Set prev_i = Nothing Set tmp = Nothing End Sub ' Copies remaining formulae down on the SHEETNAME1 sheet. Sub M10540_Copy_Post_SHEETNAME1_Formulae_Down() Dim lastrow_SHEETNAME1 As Long ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Copy Post SHEETNAME1 formulae down?", vbYesNo) = vbNo Then Exit Sub End If ' Update StatusBar. Application.StatusBar = "Copy post-SHEETNAME1 Formulae down..." With Workbooks(wb_name) With .Sheets("SHEETNAME1") ' Activate the SHEETNAME1 sheet. .Activate ' Get how many rows of data have been loaded into the sheet. lastrow_SHEETNAME1 = .Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_SHEETNAME1 < 3 Then lastrow_SHEETNAME1 = 3 End If ' Copies formulae down. .Range("F2:F2").AutoFill Destination:=.Range("F2:F" & lastrow_SHEETNAME1) .Range("F2:F" & lastrow_SHEETNAME1).Calculate .Range("F3:F" & lastrow_SHEETNAME1) = .Range("F3:F" & lastrow_SHEETNAME1).Value .Range("H2:H2").AutoFill Destination:=.Range("H2:H" & lastrow_SHEETNAME1) .Range("H2:H" & lastrow_SHEETNAME1).Calculate .Range("H3:H" & lastrow_SHEETNAME1) = .Range("H3:H" & lastrow_SHEETNAME1).Value .Range("J2:J2").AutoFill Destination:=.Range("J2:J" & lastrow_SHEETNAME1) .Range("J2:J" & lastrow_SHEETNAME1).Calculate .Range("J3:J" & lastrow_SHEETNAME1) = .Range("J3:J" & lastrow_SHEETNAME1).Value .Range("L2:L2").AutoFill Destination:=.Range("L2:L" & lastrow_SHEETNAME1) .Range("L2:L" & lastrow_SHEETNAME1).Calculate .Range("L3:L" & lastrow_SHEETNAME1) = .Range("L3:L" & lastrow_SHEETNAME1).Value .Range("M2:M2").AutoFill Destination:=.Range("M2:M" & lastrow_SHEETNAME1) .Range("M2:M" & lastrow_SHEETNAME1).Calculate .Range("M3:M" & lastrow_SHEETNAME1) = .Range("M3:M" & lastrow_SHEETNAME1).Value .Range("T2:T2").AutoFill Destination:=.Range("T2:T" & lastrow_SHEETNAME1) .Range("T2:T" & lastrow_SHEETNAME1).Calculate .Range("T3:T" & lastrow_SHEETNAME1) = .Range("T3:T" & lastrow_SHEETNAME1).Value .Range("V2:V2").AutoFill Destination:=.Range("V2:V" & lastrow_SHEETNAME1) .Range("V2:V" & lastrow_SHEETNAME1).Calculate .Range("V3:V" & lastrow_SHEETNAME1) = .Range("V3:V" & lastrow_SHEETNAME1).Value .Range("W2:W2").AutoFill Destination:=.Range("W2:W" & lastrow_SHEETNAME1) .Range("W2:W" & lastrow_SHEETNAME1).Calculate .Range("W3:W" & lastrow_SHEETNAME1) = .Range("W3:W" & lastrow_SHEETNAME1).Value .Range("X2:X2").AutoFill Destination:=.Range("X2:X" & lastrow_SHEETNAME1) .Range("X2:X" & lastrow_SHEETNAME1).Calculate .Range("X3:X" & lastrow_SHEETNAME1) = .Range("X3:X" & lastrow_SHEETNAME1).Value .Range("AB2:AB2").AutoFill Destination:=.Range("AB2:AB" & lastrow_SHEETNAME1) .Range("AB2:AB" & lastrow_SHEETNAME1).Calculate .Range("AB3:AB" & lastrow_SHEETNAME1) = .Range("AB3:AB" & lastrow_SHEETNAME1).Value .Range("AC2:AC2").AutoFill Destination:=.Range("AC2:AC" & lastrow_SHEETNAME1) .Range("AC2:AC" & lastrow_SHEETNAME1).Calculate .Range("AC3:AC" & lastrow_SHEETNAME1) = .Range("AC3:AC" & lastrow_SHEETNAME1).Value .Range("AE2:AE2").AutoFill Destination:=.Range("AE2:AE" & lastrow_SHEETNAME1) .Range("AE2:AE" & lastrow_SHEETNAME1).Calculate .Range("AE3:AE" & lastrow_SHEETNAME1) = .Range("AE3:AE" & lastrow_SHEETNAME1).Value .Range("AG2:AG2").AutoFill Destination:=.Range("AG2:AG" & lastrow_SHEETNAME1) .Range("AG2:AG" & lastrow_SHEETNAME1).Calculate .Range("AG3:AG" & lastrow_SHEETNAME1) = .Range("AG3:AG" & lastrow_SHEETNAME1).Value .Range("AH2:AH2").AutoFill Destination:=.Range("AH2:AH" & lastrow_SHEETNAME1) .Range("AH2:AH" & lastrow_SHEETNAME1).Calculate .Range("AH3:AH" & lastrow_SHEETNAME1) = .Range("AH3:AH" & lastrow_SHEETNAME1).Value .Range("AJ2:AJ2").AutoFill Destination:=.Range("AJ2:AJ" & lastrow_SHEETNAME1) .Range("AJ2:AJ" & lastrow_SHEETNAME1).Calculate .Range("AJ3:AJ" & lastrow_SHEETNAME1) = .Range("AJ3:AJ" & lastrow_SHEETNAME1).Value .Range("AK2:AK2").AutoFill Destination:=.Range("AK2:AK" & lastrow_SHEETNAME1) .Range("AK2:AK" & lastrow_SHEETNAME1).Calculate .Range("AK3:AK" & lastrow_SHEETNAME1) = .Range("AK3:AK" & lastrow_SHEETNAME1).Value .Range("AL2:AL2").AutoFill Destination:=.Range("AL2:AL" & lastrow_SHEETNAME1) .Range("AL2:AL" & lastrow_SHEETNAME1).Calculate .Range("AL3:AL" & lastrow_SHEETNAME1) = .Range("AL3:AL" & lastrow_SHEETNAME1).Value .Range("AN2:AN2").AutoFill Destination:=.Range("AN2:AN" & lastrow_SHEETNAME1) .Range("AN2:AN" & lastrow_SHEETNAME1).Calculate .Range("AN3:AN" & lastrow_SHEETNAME1) = .Range("AN3:AN" & lastrow_SHEETNAME1).Value .Range("AO2:AO2").AutoFill Destination:=.Range("AO2:AO" & lastrow_SHEETNAME1) .Range("AO2:AO" & lastrow_SHEETNAME1).Calculate .Range("AO3:AO" & lastrow_SHEETNAME1) = .Range("AO3:AO" & lastrow_SHEETNAME1).Value .Range("AP2:AP2").AutoFill Destination:=.Range("AP2:AP" & lastrow_SHEETNAME1) .Range("AP2:AP" & lastrow_SHEETNAME1).Calculate .Range("AP3:AP" & lastrow_SHEETNAME1) = .Range("AP3:AP" & lastrow_SHEETNAME1).Value .Range("AQ2:AQ2").AutoFill Destination:=.Range("AQ2:AQ" & lastrow_SHEETNAME1) .Range("AQ2:AQ" & lastrow_SHEETNAME1).Calculate .Range("AQ3:AQ" & lastrow_SHEETNAME1) = .Range("AQ3:AQ" & lastrow_SHEETNAME1).Value .Range("AR2:AR2").AutoFill Destination:=.Range("AR2:AR" & lastrow_SHEETNAME1) .Range("AR2:AR" & lastrow_SHEETNAME1).Calculate .Range("AR3:AR" & lastrow_SHEETNAME1) = .Range("AR3:AR" & lastrow_SHEETNAME1).Value .Range("AS2:AS2").AutoFill Destination:=.Range("AS2:AS" & lastrow_SHEETNAME1) .Range("AS2:AS" & lastrow_SHEETNAME1).Calculate .Range("AS3:AS" & lastrow_SHEETNAME1) = .Range("AS3:AS" & lastrow_SHEETNAME1).Value .Range("AT2:AT2").AutoFill Destination:=.Range("AT2:AT" & lastrow_SHEETNAME1) .Range("AT2:AT" & lastrow_SHEETNAME1).Calculate .Range("AT3:AT" & lastrow_SHEETNAME1) = .Range("AT3:AT" & lastrow_SHEETNAME1).Value .Range("AV2:AV2").AutoFill Destination:=.Range("AV2:AV" & lastrow_SHEETNAME1) .Range("AV2:AV" & lastrow_SHEETNAME1).Calculate .Range("AV3:AV" & lastrow_SHEETNAME1) = .Range("AV3:AV" & lastrow_SHEETNAME1).Value .Range("AW2:AW2").AutoFill Destination:=.Range("AW2:AW" & lastrow_SHEETNAME1) .Range("AW2:AW" & lastrow_SHEETNAME1).Calculate .Range("AW3:AW" & lastrow_SHEETNAME1) = .Range("AW3:AW" & lastrow_SHEETNAME1).Value .Range("AX2:AX2").AutoFill Destination:=.Range("AX2:AX" & lastrow_SHEETNAME1) .Range("AX2:AX" & lastrow_SHEETNAME1).Calculate .Range("AX3:AX" & lastrow_SHEETNAME1) = .Range("AX3:AX" & lastrow_SHEETNAME1).Value .Range("AY2:AY2").AutoFill Destination:=.Range("AY2:AY" & lastrow_SHEETNAME1) .Range("AY2:AY" & lastrow_SHEETNAME1).Calculate .Range("AY3:AY" & lastrow_SHEETNAME1) = .Range("AY3:AY" & lastrow_SHEETNAME1).Value .Range("BB2:BB2").AutoFill Destination:=.Range("BB2:BB" & lastrow_SHEETNAME1) .Range("BB2:BB" & lastrow_SHEETNAME1).Calculate .Range("BB3:BB" & lastrow_SHEETNAME1) = .Range("BB3:BB" & lastrow_SHEETNAME1).Value .Range("BD2:BD2").AutoFill Destination:=.Range("BD2:BD" & lastrow_SHEETNAME1) .Range("BD2:BD" & lastrow_SHEETNAME1).Calculate .Range("BD3:BD" & lastrow_SHEETNAME1) = .Range("BD3:BD" & lastrow_SHEETNAME1).Value .Range("BE2:BE2").AutoFill Destination:=.Range("BE2:BE" & lastrow_SHEETNAME1) .Range("BE2:BE" & lastrow_SHEETNAME1).Calculate .Range("BE3:BE" & lastrow_SHEETNAME1) = .Range("BE3:BE" & lastrow_SHEETNAME1).Value .Range("BG2:BG2").AutoFill Destination:=.Range("BG2:BG" & lastrow_SHEETNAME1) .Range("BG2:BG" & lastrow_SHEETNAME1).Calculate .Range("BG3:BG" & lastrow_SHEETNAME1) = .Range("BG3:BG" & lastrow_SHEETNAME1).Value .Range("BH2:BH2").AutoFill Destination:=.Range("BH2:BH" & lastrow_SHEETNAME1) .Range("BH2:BH" & lastrow_SHEETNAME1).Calculate .Range("BH3:BH" & lastrow_SHEETNAME1) = .Range("BH3:BH" & lastrow_SHEETNAME1).Value .Range("BI2:BI2").AutoFill Destination:=.Range("BI2:BI" & lastrow_SHEETNAME1) .Range("BI2:BI" & lastrow_SHEETNAME1).Calculate .Range("BI3:BI" & lastrow_SHEETNAME1) = .Range("BI3:BI" & lastrow_SHEETNAME1).Value .Range("BJ2:BJ2").AutoFill Destination:=.Range("BJ2:BJ" & lastrow_SHEETNAME1) .Range("BJ2:BJ" & lastrow_SHEETNAME1).Calculate .Range("BJ3:BJ" & lastrow_SHEETNAME1) = .Range("BJ3:BJ" & lastrow_SHEETNAME1).Value .Range("BK2:BK2").AutoFill Destination:=.Range("BK2:BK" & lastrow_SHEETNAME1) .Range("BK2:BK" & lastrow_SHEETNAME1).Calculate .Range("BK3:BK" & lastrow_SHEETNAME1) = .Range("BK3:BK" & lastrow_SHEETNAME1).Value .Range("BL2:BL2").AutoFill Destination:=.Range("BL2:BL" & lastrow_SHEETNAME1) .Range("BL2:BL" & lastrow_SHEETNAME1).Calculate .Range("BL3:BL" & lastrow_SHEETNAME1) = .Range("BL3:BL" & lastrow_SHEETNAME1).Value .Range("BM2:BM2").AutoFill Destination:=.Range("BM2:BM" & lastrow_SHEETNAME1) .Range("BM2:BM" & lastrow_SHEETNAME1).Calculate .Range("BM3:BM" & lastrow_SHEETNAME1) = .Range("BM3:BM" & lastrow_SHEETNAME1).Value End With End With End Sub ' Now that both Final and SHEETNAME1 sheets populated, need to action some more formulae calculations. Sub M10600_Copy_More_FinalABC_Formulae_Down() 'Dim mycell As Variant Dim lastrow_FinalABC As Long ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Copy more FinalABC formulae down?", vbYesNo) = vbNo Then Exit Sub End If ' Update StatusBar. Application.StatusBar = "Copy more BBH Formulae down..." With Workbooks(wb_name) With .Sheets("FinalABC") ' Activate the sheet. .Activate ' Get how many rows of data have been loaded into the sheet. lastrow_FinalABC = .Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_FinalABC < 3 Then lastrow_FinalABC = 3 End If ' Copies formulae down. .Range("L2:N2").AutoFill Destination:=.Range("L2:N" & lastrow_FinalABC) .Range("P2:Q2").AutoFill Destination:=.Range("P2:Q" & lastrow_FinalABC) .Range("AI2:AM2").AutoFill Destination:=.Range("AI2:AM" & lastrow_FinalABC) .Range("AR2:AT2").AutoFill Destination:=.Range("AR2:AT" & lastrow_FinalABC) .Range("B2:B2").AutoFill Destination:=.Range("B2:B" & lastrow_FinalABC) ' Calculations. .Range("P2:Q" & lastrow_FinalABC).Calculate .Range("L2:N" & lastrow_FinalABC).Calculate .Range("AI2:AM" & lastrow_FinalABC).Calculate .Range("AR2:AT" & lastrow_FinalABC).Calculate .Range("B2:B" & lastrow_FinalABC).Calculate ' Now copy and paste formula ranges as values to speed up the file processing. .Range("K3:N" & lastrow_FinalABC) = .Range("K3:N" & lastrow_FinalABC).Value .Range("P3:Q" & lastrow_FinalABC) = .Range("P3:Q" & lastrow_FinalABC).Value .Range("AI3:AM" & lastrow_FinalABC) = .Range("AI3:AM" & lastrow_FinalABC).Value .Range("AR3:AT" & lastrow_FinalABC) = .Range("AR3:AT" & lastrow_FinalABC).Value .Range("B3:B" & lastrow_FinalABC) = .Range("B3:B" & lastrow_FinalABC).Value End With End With End Sub ' Adds 1 to the Corrected Date, column E, in the FinalABC sheet for dates that were the last date of the month. ' It then recalculates the sheet to determine if column AL now reconciles, i.e. shows "MATCHED GROSS AMOUNT ISIN BY MONTH". ' This requires the following columns to have formulae throughout: E, L, K, AK, AL Sub M10610_Reformat_FinalABC_Corrected_Dates() Dim lastrow_FinalABC As Long Dim cell_date As Date Dim LastDayOfMonth As Date Dim pt As PivotTable Dim i As Long ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Reformat FinalABC Corrected Dates?", vbYesNo) = vbNo Then Exit Sub End If With Workbooks(wb_name) With .Sheets("FinalABC") ' Activate the sheet. .Activate ' Get how many rows of data have been loaded into the sheet. lastrow_FinalABC = .Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_FinalABC < 3 Then lastrow_FinalABC = 3 End If ' Loop through every row and where column AJ does not match, it then changes the date in column E to the ' 1st of the next month and again checks if column AJ matches. If not then it reverts otherwise it keeps ' the newly calculated values. For i = 2 To lastrow_FinalABC If RTrim(LTrim(.Range("AL" & i).Value)) = "GROSS AMOUNT NOT MATCHED ISIN BY MONTH" Then cell_date = .Range("E" & i).Value LastDayOfMonth = DateSerial(Year(cell_date), Month(cell_date + 1), 0) If cell_date = LastDayOfMonth Then ' Change for formula in column E to add 1 to the date. This should make dates that are the last day of the month now reflect ' the 1st of the following month. .Range("E" & i).Formula = "=TEXT(TEXT(MID(F" & i & ",FIND("" "",F" & i & ")+1,FIND("","",F" & i & ")-FIND("" "",F" & i & ")-1)&"" ""&LEFT(F" & i & ",FIND("" "",F" & i & ")-1)&"" ""&RIGHT(F" & i & ",4),""dd/mm/yyyy"")+1,""dd/mm/yyyy"")" .Range("A" & i & ":C" & i).Formula = .Range("A2:C2").FormulaR1C1 .Range("A" & i & ":C" & i).Calculate .Range("K" & i & ":N" & i).Formula = .Range("K2:N2").FormulaR1C1 .Range("K" & i & ":N" & i).Calculate .Range("AI" & i & ":AM" & i).Formula = .Range("AI2:AM2").FormulaR1C1 .Range("AI" & i & ":AM" & i).Calculate .Range("AR" & i & ":AT" & i).Formula = .Range("AR2:AT2").FormulaR1C1 .Range("AR" & i & ":AT" & i).Calculate ' If column AJ is unchanged then the change of the date did not work. So reset back. If RTrim(LTrim(Range("AJ" & i).Value)) = "GROSS AMOUNT NOT MATCHED ISIN BY MONTH" Then .Range("E" & i).Formula = "=TEXT(MID(F" & i & ",FIND("" "",F" & i & ")+1,FIND("","",F" & i & ")-FIND("" "",F" & i & ")-1)&"" ""&LEFT(F" & i & ",FIND("" "",F" & i & ")-1)&"" ""&RIGHT(F" & i & ",4),""dd/mm/yyyy"")" .Range("A" & i & ":C" & i).Formula = .Range("A2:C2").FormulaR1C1 .Range("A" & i & ":C" & i).Calculate .Range("K" & i & ":N" & i).Formula = .Range("K2:N2").FormulaR1C1 .Range("K" & i & ":N" & i).Calculate .Range("AI" & i & ":AM" & i).Formula = .Range("AI2:AM2").FormulaR1C1 .Range("AI" & i & ":AM" & i).Calculate .Range("AR" & i & ":AT" & i).Formula = .Range("AR2:AT2").FormulaR1C1 .Range("AR" & i & ":AT" & i).Calculate Else ' Column AJ has changed therefore change of date in column E has worked. So save as values. If (i <> 2) Then ' Do not process for column 2 as we need to retain the formulae. .Range("A" & i & ":C" & i) = .Range("A" & i & ":C" & i).Value .Range("K" & i & ":N" & i) = .Range("K" & i & ":N" & i).Value .Range("AI" & i & ":AM" & i) = .Range("AI" & i & ":AM" & i).Value .Range("AR" & i & ":AT" & i) = .Range("AR" & i & ":AT" & i).Value End If End If End If End If Next i End With ' Refresh Mapping Pivots With .Sheets("Mapping Pivots") ' Activate the sheet. .Activate ' Refresh all the pivot tables on the Mapping Pivots sheet. 'For Each Sheet In ThisWorkbook.Worksheets 'For Each Pivot In Sheet.PivotTables For Each pt In .PivotTables pt.RefreshTable pt.Update Next 'Next End With End With ' Clear all objects. Set pt = Nothing End Sub ' Speedy - copies using arrays. ' Copies remaining formulae down on the SHEETNAME1 sheet. Sub M10615_Recalc_SHEETNAME1_Formulae_Array() Dim lastrow_CUST As Long Dim lastrow_SHEETNAME1 As Long Dim lastrow_FinalABC As Long Dim lastrow_HOLDINGS As Long Dim lastrow_MappingPivots As Long Dim lastrow_MappingPivots2 As Long Dim lastrow_MappingPivots3 As Long Dim lastrow_References As Long Dim lastrow_References_adjusted_rate As Long Dim lastrow_References_g3_location As Long Dim lastrow_References_income_type As Long Dim lastrow_References_allowed_locations As Long Dim lastrow_QSHEET As Long Dim lastrow_TRANSACTIONS As Long Dim lastrow_Wxxxx As Long Dim column_a As Variant Dim column_b As Variant Dim column_e As Variant Dim column_f As Variant Dim column_g As Variant Dim column_h As Variant Dim column_i As Variant Dim column_k As Variant Dim column_m As Variant Dim column_n As Variant Dim column_p As Variant Dim column_r As Variant Dim column_t As Variant Dim column_u As Variant Dim column_x As Variant Dim column_y As Variant Dim column_ab As Variant Dim column_ad As Variant Dim column_af As Variant Dim column_ai As Variant Dim column_aj As Variant Dim column_am As Variant Dim column_an As Variant Dim column_ao As Variant Dim column_aq As Variant Dim column_ar As Variant Dim column_au As Variant Dim column_aw As Variant Dim column_bb As Variant Dim column_bd As Variant Dim column_bh As Variant Dim column_a_CUST As Variant Dim column_b_CUST As Variant Dim column_a_FinalABC As Variant Dim column_d_FinalABC As Variant Dim column_k_FinalABC As Variant Dim column_n_FinalABC As Variant Dim column_a_HOLDINGS As Variant Dim column_f_HOLDINGS As Variant Dim column_a_MappingPivots As Variant Dim column_b_MappingPivots As Variant Dim column_c_MappingPivots As Variant Dim column_d_MappingPivots As Variant Dim column_f_MappingPivots As Variant Dim column_g_MappingPivots As Variant Dim column_h_MappingPivots As Variant Dim column_i_MappingPivots As Variant Dim column_m_MappingPivots As Variant Dim column_k_MappingPivots As Variant Dim column_a_QSHEET As Variant Dim column_a_References As Variant Dim column_b_References As Variant Dim column_h_References As Variant Dim column_i_References As Variant Dim column_j_References As Variant Dim column_k_References As Variant Dim column_o_References As Variant Dim column_p_References As Variant Dim column_q_References As Variant Dim column_s_References As Variant Dim column_u_References As Variant Dim column_ag_References As Variant Dim column_a_TRANSACTIONS As Variant Dim column_l_TRANSACTIONS As Variant Dim column_m_TRANSACTIONS As Variant Dim column_n_TRANSACTIONS As Variant Dim column_b_Wxxxx As Variant Dim column_y_Wxxxx As Variant Dim column_z_Wxxxx As Variant Dim prev_a As Variant Dim prev_b As Variant Dim prev_c As Variant Dim prev_d As Variant Dim prev_f As Variant Dim prev_g As Variant Dim prev_h As Variant Dim prev_i As Variant Dim tmp As Variant Dim working As Variant Dim n As Long ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Recalc_SHEETNAME1_Formulae_Array?", vbYesNo) = vbNo Then Exit Sub End If With Workbooks(wb_name) With .Sheets("SHEETNAME1") ' Activate the SHEETNAME1 sheet. .Activate ' Get how many rows of data have been loaded into the sheet. lastrow_SHEETNAME1 = .Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_SHEETNAME1 < 3 Then lastrow_SHEETNAME1 = 3 End If lastrow_CUST = Sheets("CUST").Cells(Rows.Count, 1).End(xlUp).Row lastrow_FinalABC = Sheets("FinalABC").Cells(Rows.Count, 4).End(xlUp).Row lastrow_HOLDINGS = Sheets("HOLDINGS").Cells(Rows.Count, 1).End(xlUp).Row lastrow_MappingPivots = Sheets("Mapping Pivots").Cells(Rows.Count, 1).End(xlUp).Row lastrow_MappingPivots2 = Sheets("Mapping Pivots").Cells(Rows.Count, 6).End(xlUp).Row lastrow_MappingPivots3 = Sheets("Mapping Pivots").Cells(Rows.Count, 11).End(xlUp).Row lastrow_References = Sheets("References").Cells(Rows.Count, 1).End(xlUp).Row lastrow_References_adjusted_rate = Sheets("References").Cells(Rows.Count, 8).End(xlUp).Row lastrow_References_g3_location = Sheets("References").Cells(Rows.Count, 15).End(xlUp).Row lastrow_References_income_type = Sheets("References").Cells(Rows.Count, 19).End(xlUp).Row lastrow_References_allowed_locations = Sheets("References").Cells(Rows.Count, 33).End(xlUp).Row lastrow_QSHEET = Sheets("QSHEET").Cells(Rows.Count, 1).End(xlUp).Row lastrow_TRANSACTIONS = Sheets("TRANSACTIONS").Cells(Rows.Count, 1).End(xlUp).Row lastrow_Wxxxx = Sheets("Wxxxx").Cells(Rows.Count, 2).End(xlUp).Row ReDim working(1 To lastrow_SHEETNAME1, 1) ' Working array ReDim column_a(1 To lastrow_SHEETNAME1, 1) ReDim column_b(1 To lastrow_SHEETNAME1, 1) ReDim column_e(1 To lastrow_SHEETNAME1, 1) ReDim column_f(1 To lastrow_SHEETNAME1, 1) ReDim column_g(1 To lastrow_SHEETNAME1, 1) ReDim column_h(1 To lastrow_SHEETNAME1, 1) ReDim column_i(1 To lastrow_SHEETNAME1, 1) ReDim column_k(1 To lastrow_SHEETNAME1, 1) ReDim column_m(1 To lastrow_SHEETNAME1, 1) ReDim column_n(1 To lastrow_SHEETNAME1, 1) ReDim column_p(1 To lastrow_SHEETNAME1, 1) ReDim column_r(1 To lastrow_SHEETNAME1, 1) ReDim column_t(1 To lastrow_SHEETNAME1, 1) ReDim column_u(1 To lastrow_SHEETNAME1, 1) ReDim column_x(1 To lastrow_SHEETNAME1, 1) ReDim column_y(1 To lastrow_SHEETNAME1, 1) ReDim column_ab(1 To lastrow_SHEETNAME1, 1) ReDim column_ad(1 To lastrow_SHEETNAME1, 1) ReDim column_af(1 To lastrow_SHEETNAME1, 1) ReDim column_ai(1 To lastrow_SHEETNAME1, 1) ReDim column_aj(1 To lastrow_SHEETNAME1, 1) ReDim column_am(1 To lastrow_SHEETNAME1, 1) ReDim column_an(1 To lastrow_SHEETNAME1, 1) ReDim column_ao(1 To lastrow_SHEETNAME1, 1) ReDim column_aq(1 To lastrow_SHEETNAME1, 1) ReDim column_ar(1 To lastrow_SHEETNAME1, 1) ReDim column_au(1 To lastrow_SHEETNAME1, 1) ReDim column_aw(1 To lastrow_SHEETNAME1, 1) ReDim column_bd(1 To lastrow_SHEETNAME1, 1) ReDim column_bh(1 To lastrow_SHEETNAME1, 1) ReDim column_a_CUST(1 To lastrow_CUST, 1) ReDim column_b_CUST(1 To lastrow_CUST, 1) ReDim column_a_FinalABC(1 To lastrow_FinalABC, 1) ReDim column_d_FinalABC(1 To lastrow_FinalABC, 1) ReDim column_k_FinalABC(1 To lastrow_FinalABC, 1) ReDim column_n_FinalABC(1 To lastrow_FinalABC, 1) ReDim column_a_HOLDINGS(1 To lastrow_HOLDINGS, 1) ReDim column_g_HOLDINGS(1 To lastrow_HOLDINGS, 1) ReDim column_a_MappingPivots(1 To lastrow_MappingPivots, 1) ReDim column_b_MappingPivots(1 To lastrow_MappingPivots, 1) ReDim column_c_MappingPivots(1 To lastrow_MappingPivots, 1) ReDim column_d_MappingPivots(1 To lastrow_MappingPivots, 1) ReDim column_f_MappingPivots(1 To lastrow_MappingPivots, 1) ReDim column_g_MappingPivots(1 To lastrow_MappingPivots, 1) ReDim column_h_MappingPivots(1 To lastrow_MappingPivots, 1) ReDim column_i_MappingPivots(1 To lastrow_MappingPivots, 1) ReDim column_m_MappingPivots(1 To lastrow_MappingPivots, 1) ReDim column_k_MappingPivots(1 To lastrow_MappingPivots, 1) ReDim column_a_References(1 To lastrow_References, 1) ReDim column_b_References(1 To lastrow_References, 1) ReDim column_h_References(1 To lastrow_References, 1) ReDim column_i_References(1 To lastrow_References, 1) ReDim column_j_References(1 To lastrow_References, 1) ReDim column_k_References(1 To lastrow_References, 1) ReDim column_o_References(1 To lastrow_References, 1) ReDim column_p_References(1 To lastrow_References, 1) ReDim column_q_References(1 To lastrow_References, 1) ReDim column_s_References(1 To lastrow_References, 1) ReDim column_u_References(1 To lastrow_References, 1) ReDim column_ag_References(1 To lastrow_References, 1) ReDim column_a_QSHEET(1 To lastrow_QSHEET, 1) ReDim column_a_TRANSACTIONS(1 To lastrow_TRANSACTIONS, 1) ReDim column_l_TRANSACTIONS(1 To lastrow_TRANSACTIONS, 1) ReDim column_m_TRANSACTIONS(1 To lastrow_TRANSACTIONS, 1) ReDim column_n_TRANSACTIONS(1 To lastrow_TRANSACTIONS, 1) ReDim column_b_Wxxxx(1 To lastrow_Wxxxx, 1) ReDim column_y_Wxxxx(1 To lastrow_Wxxxx, 1) ReDim column_z_Wxxxx(1 To lastrow_Wxxxx, 1) working = Range("D3:D" & lastrow_SHEETNAME1) ' load with dummy values. ' Column X ' =IF(ISNA(VLOOKUP(A2,FinalABC!A$1:A$2227,1,FALSE)),"NON EXIST","EXIST") column_a = Range("A3:A" & lastrow_SHEETNAME1) column_a_FinalABC = Sheets("FinalABC").Range("A3:A" & lastrow_FinalABC) For n = LBound(working) To UBound(working) working(n, 1) = ArrayFindEx(column_a_FinalABC, column_a(n, 1), "EXIST", "NON EXIST") Next n .Range("X3:X" & lastrow_SHEETNAME1).Value = working ' Column AB ' =IF(OR(X2="NON EXIST",Y2="EXCLUDE"),"NON REPORTABLE",A2&" - "&ROUND(F2,0)) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_a = Range("A3:A" & lastrow_SHEETNAME1) column_f = Range("F3:F" & lastrow_SHEETNAME1) For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then working(n, 1) = "NON REPORTABLE" Else working(n, 1) = column_a(n, 1) & " - " & Round(column_f(n, 1), 0) End If Next n .Range("AB3:AB" & lastrow_SHEETNAME1).Value = working ' Column AC ' =IF(OR($X2="NON EXIST",$Y2="EXCLUDE"),"NON REPORTABLE",IFERROR(VLOOKUP($A2,'Mapping Pivots'!$A$4:$B$1458,2,FALSE), IFERROR(VLOOKUP($AB2,'Mapping Pivots'!$F$4:$G$2230,2,FALSE), "MANUAL INPUT"))) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_a = Range("A3:A" & lastrow_SHEETNAME1) column_ab = Range("AB3:AB" & lastrow_SHEETNAME1) column_a_MappingPivots = Sheets("Mapping Pivots").Range("A4:A" & lastrow_MappingPivots) column_b_MappingPivots = Sheets("Mapping Pivots").Range("B4:B" & lastrow_MappingPivots) column_f_MappingPivots = Sheets("Mapping Pivots").Range("F4:F" & lastrow_MappingPivots2) column_g_MappingPivots = Sheets("Mapping Pivots").Range("G4:G" & lastrow_MappingPivots2) ' Tidy up for Mapping Pivots columns. Often they are Empty when reporting a 2nd line for same key value. ' This effects binary searches, so initially in the columns if a blank is encountered then actual value ' is written in its place. prev_a = column_a_MappingPivots(LBound(column_a_MappingPivots), 1) prev_b = column_b_MappingPivots(LBound(column_b_MappingPivots), 1) For n = LBound(column_a_MappingPivots) To UBound(column_a_MappingPivots) If column_a_MappingPivots(n, 1) = "" Then column_a_MappingPivots(n, 1) = prev_a End If If column_b_MappingPivots(n, 1) = "" Then column_b_MappingPivots(n, 1) = prev_b End If prev_a = column_a_MappingPivots(n, 1) prev_b = column_b_MappingPivots(n, 1) Next n prev_f = column_f_MappingPivots(LBound(column_f_MappingPivots), 1) prev_g = column_g_MappingPivots(LBound(column_g_MappingPivots), 1) For n = LBound(column_f_MappingPivots) To UBound(column_f_MappingPivots) If column_f_MappingPivots(n, 1) = "" Then column_f_MappingPivots(n, 1) = prev_f End If If column_g_MappingPivots(n, 1) = "" Then column_g_MappingPivots(n, 1) = prev_g End If prev_f = column_f_MappingPivots(n, 1) prev_g = column_g_MappingPivots(n, 1) Next n For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then working(n, 1) = "NON REPORTABLE" Else If ArrayCountIf(column_a_MappingPivots, column_a(n, 1)) > 0 Then working(n, 1) = ArrayFind(column_a_MappingPivots, column_a(n, 1), column_b_MappingPivots, 0) Else If ArrayCountIf(column_f_MappingPivots, column_ab(n, 1)) > 0 Then working(n, 1) = ArrayFind(column_f_MappingPivots, column_ab(n, 1), column_g_MappingPivots, 0) Else working(n, 1) = "MANUAL INPUT" End If End If End If Next n .Range("AC3:AC" & lastrow_SHEETNAME1).Value = working ' .Range("AC2:AC2").AutoFill Destination:=.Range("AC2:AC" & lastrow_SHEETNAME1) ' .Range("AC2:AC" & lastrow_SHEETNAME1).Calculate ' .Range("AC3:AC" & lastrow_SHEETNAME1) = .Range("AC3:AC" & lastrow_SHEETNAME1).Value ' Column AE ' =IF(OR($X2="NON EXIST",$Y2="EXCLUDE"),"NON REPORTABLE",IFERROR(VLOOKUP($A2,'Mapping Pivots'!$A$4:$C$1458,3,FALSE),IFERROR(VLOOKUP($AB2,'Mapping Pivots'!$F$4:$H$2230,3,FALSE), "MANUAL INPUT"))) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_a = Range("A3:A" & lastrow_SHEETNAME1) column_ab = Range("AB3:AB" & lastrow_SHEETNAME1) column_a_MappingPivots = Sheets("Mapping Pivots").Range("A4:A" & lastrow_MappingPivots) column_c_MappingPivots = Sheets("Mapping Pivots").Range("C4:C" & lastrow_MappingPivots) column_f_MappingPivots = Sheets("Mapping Pivots").Range("F4:F" & lastrow_MappingPivots2) column_h_MappingPivots = Sheets("Mapping Pivots").Range("H4:H" & lastrow_MappingPivots2) ' Tidy up for Mapping Pivots columns. Often they are Empty when reporting a 2nd line for same key value. ' This effects binary searches, so initially in the columns if a blank is encountered then actual value ' is written in its place. prev_a = column_a_MappingPivots(LBound(column_a_MappingPivots), 1) prev_c = column_c_MappingPivots(LBound(column_c_MappingPivots), 1) For n = LBound(column_a_MappingPivots) To UBound(column_a_MappingPivots) If column_a_MappingPivots(n, 1) = "" Then column_a_MappingPivots(n, 1) = prev_a End If If column_c_MappingPivots(n, 1) = "" Then column_c_MappingPivots(n, 1) = prev_c End If prev_a = column_a_MappingPivots(n, 1) prev_c = column_c_MappingPivots(n, 1) Next n prev_f = column_f_MappingPivots(LBound(column_f_MappingPivots), 1) prev_h = column_h_MappingPivots(LBound(column_h_MappingPivots), 1) For n = LBound(column_f_MappingPivots) To UBound(column_f_MappingPivots) If column_f_MappingPivots(n, 1) = "" Then column_f_MappingPivots(n, 1) = prev_f End If If column_h_MappingPivots(n, 1) = "" Then column_h_MappingPivots(n, 1) = prev_h End If prev_f = column_f_MappingPivots(n, 1) prev_h = column_h_MappingPivots(n, 1) Next n For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then working(n, 1) = "NON REPORTABLE" Else If ArrayCountIf(column_a_MappingPivots, column_a(n, 1)) > 0 Then working(n, 1) = ArrayFind(column_a_MappingPivots, column_a(n, 1), column_c_MappingPivots, 0) Else If ArrayCountIf(column_f_MappingPivots, column_ab(n, 1)) > 0 Then working(n, 1) = ArrayFind(column_f_MappingPivots, column_ab(n, 1), column_h_MappingPivots, 0) Else working(n, 1) = "MANUAL INPUT" End If End If End If Next n .Range("AE3:AE" & lastrow_SHEETNAME1).Value = working ' TODO Peter, this might be able to be combined with previous calc on column AC, as using same lookups. ' Simply use a different 'working' for data to write to column AE. ' .Range("AE2:AE2").AutoFill Destination:=.Range("AE2:AE" & lastrow_SHEETNAME1) ' .Range("AE2:AE" & lastrow_SHEETNAME1).Calculate ' .Range("AE3:AE" & lastrow_SHEETNAME1) = .Range("AE3:AE" & lastrow_SHEETNAME1).Value ' Column AG ' =IF(OR($X2="NON EXIST",$Y2="EXCLUDE"),"NON REPORTABLE",IF(COUNTIF($A$1:A2,A2)>1,"AGGREGATE",ROUND(SUMIF($A$1:$A$52435,A2,$I$1:$I$52435)-SUMIF(FinalABC!$A$1:$A$2227,A2,FinalABC!$N$1:$N$2227),2))) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_a = Range("A3:A" & lastrow_SHEETNAME1) column_i = Range("I3:I" & lastrow_SHEETNAME1) column_a_FinalABC = Sheets("FinalABC").Range("A3:A" & lastrow_FinalABC) column_n_FinalABC = Sheets("FinalABC").Range("N3:N" & lastrow_FinalABC) For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then working(n, 1) = "NON REPORTABLE" Else If ArrayCountIf(column_a, column_a(n, 1)) > 1 Then working(n, 1) = "AGGREGATE" Else working(n, 1) = Round(ArraySumIf(column_a, column_a(n, 1), column_i) - ArraySumIf(column_a_FinalABC, column_a(n, 1), column_n_FinalABC), 2) End If End If Next n .Range("AG3:AG" & lastrow_SHEETNAME1).Value = working ' Column AH ' =IF(AG2="NON REPORTABLE",AG2,IF(AND(ROUND(SUMIFS($I$1:$I$52435,$A$1:$A$52435,A2,$Y$1:$Y$52435,"INCLUDE")-SUMIF(FinalABC!$A$1:$A$2227,A2,FinalABC!$N$1:$N$2227),2)>-1,ROUND(SUMIFS($I$1:$I$52435,$A$1:$A$52435,A2,$Y$1:$Y$52435,"INCLUDE")-SUMIF(FinalABC!$A$1:$A$2227,A2,FinalABC!$N$1:$N$2227),2)<1),K2,"MANUAL INPUT")) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_a = Range("A3:A" & lastrow_SHEETNAME1) column_i = Range("I3:I" & lastrow_SHEETNAME1) column_a_FinalABC = Sheets("FinalABC").Range("A3:A" & lastrow_FinalABC) column_n_FinalABC = Sheets("FinalABC").Range("N3:N" & lastrow_FinalABC) For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then 'If working(n, 1) = "NON REPORTABLE" Then working(n, 1) = "NON REPORTABLE" Else If (column_y(n, 1) = "INCLUDE") Then working(n, 1) = Round(ArraySumIf(column_a, column_a(n, 1), column_i) - ArraySumIf(column_a_FinalABC, column_a(n, 1), column_n_FinalABC), 2) If ((working(n, 1) > -1) Or (working(n, 1) < 1)) Then working(n, 1) = column_k(n, 1) Else working(n, 1) = "MANUAL INPUT" End If Else working(n, 1) = "MANUAL INPUT" End If End If Next n .Range("AH3:AH" & lastrow_SHEETNAME1).Value = working ' Copy adjustment data. 'zzzz .Range("AI2:AI" & lastrow_SHEETNAME1) = .Range("AH2:AH" & lastrow_SHEETNAME1).Value ' Column AJ ' =IF(OR($X2="NON EXIST",$Y2="EXCLUDE"),"NON REPORTABLE",ROUND(E2*SUM(AI2/100),2)) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_e = Range("E3:E" & lastrow_SHEETNAME1) column_ai = Range("AI3:AI" & lastrow_SHEETNAME1) For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then working(n, 1) = "NON REPORTABLE" Else If IsNumeric(column_ai(n, 1)) Then ' To cater for "Manual Input" in column AI. working(n, 1) = Round(column_e(n, 1) * column_ai(n, 1) / 100, 2) Else working(n, 1) = 0 End If End If Next n .Range("AJ3:AJ" & lastrow_SHEETNAME1).Value = working ' Column AK ' =IF(OR($X2="NON EXIST",$Y2="EXCLUDE"),"NON REPORTABLE",SUMIF($A$1:$A$52435,A2,$AJ$1:$AJ$52435)-SUMIF(FinalABC!$A$1:$A$2227,A2,FinalABC!$N$1:$N$2227)) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_a = Range("A3:A" & lastrow_SHEETNAME1) column_aj = Range("AJ3:AJ" & lastrow_SHEETNAME1) column_a_FinalABC = Sheets("FinalABC").Range("A3:A" & lastrow_FinalABC) column_n_FinalABC = Sheets("FinalABC").Range("N3:N" & lastrow_FinalABC) For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then working(n, 1) = "NON REPORTABLE" Else 'working(n, 1) = Round(ArraySumIf(column_a, column_a(n, 1), column_ai) - ArraySumIf(column_a_FinalABC, column_a(n, 1), column_n_FinalABC), 2) working(n, 1) = ArraySumIf(column_a, column_a(n, 1), column_aj) - ArraySumIf(column_a_FinalABC, column_a(n, 1), column_n_FinalABC) End If Next n .Range("AK3:AK" & lastrow_SHEETNAME1).Value = working ' Column AL ' =IF(OR($X2="NON EXIST",$Y2="EXCLUDE"), "NON REPORTABLE", IFERROR(VLOOKUP($A2,'Mapping Pivots'!$A$4:$D$1458,4,FALSE), IFERROR(VLOOKUP($AB2,'Mapping Pivots'!$F$4:$I$2230,4,FALSE), "MANUAL INPUT"))) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_a = Range("A3:A" & lastrow_SHEETNAME1) column_ab = Range("AB3:AB" & lastrow_SHEETNAME1) column_a_MappingPivots = Sheets("Mapping Pivots").Range("A4:A" & lastrow_MappingPivots) column_d_MappingPivots = Sheets("Mapping Pivots").Range("D4:D" & lastrow_MappingPivots) column_f_MappingPivots = Sheets("Mapping Pivots").Range("F4:F" & lastrow_MappingPivots2) column_i_MappingPivots = Sheets("Mapping Pivots").Range("I4:I" & lastrow_MappingPivots2) ' Tidy up for Mapping Pivots columns. Often they are Empty when reporting a 2nd line for same key value. ' This effects binary searches, so initially in the columns if a blank is encountered then actual value ' is written in its place. prev_a = column_a_MappingPivots(LBound(column_a_MappingPivots), 1) prev_d = column_d_MappingPivots(LBound(column_d_MappingPivots), 1) For n = LBound(column_a_MappingPivots) To UBound(column_a_MappingPivots) If column_a_MappingPivots(n, 1) = "" Then column_a_MappingPivots(n, 1) = prev_a End If If column_d_MappingPivots(n, 1) = "" Then column_d_MappingPivots(n, 1) = prev_d End If prev_a = column_a_MappingPivots(n, 1) prev_d = column_d_MappingPivots(n, 1) Next n prev_f = column_f_MappingPivots(LBound(column_f_MappingPivots), 1) prev_i = column_i_MappingPivots(LBound(column_i_MappingPivots), 1) For n = LBound(column_f_MappingPivots) To UBound(column_f_MappingPivots) If column_f_MappingPivots(n, 1) = "" Then column_f_MappingPivots(n, 1) = prev_f End If If column_i_MappingPivots(n, 1) = "" Then column_i_MappingPivots(n, 1) = prev_i End If prev_f = column_f_MappingPivots(n, 1) prev_i = column_i_MappingPivots(n, 1) Next n For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then working(n, 1) = "NON REPORTABLE" Else If ArrayCountIf(column_a_MappingPivots, column_a(n, 1)) > 0 Then working(n, 1) = ArrayFind(column_a_MappingPivots, column_a(n, 1), column_d_MappingPivots, 0) Else If ArrayCountIf(column_f_MappingPivots, column_ab(n, 1)) > 0 Then working(n, 1) = ArrayFind(column_f_MappingPivots, column_ab(n, 1), column_i_MappingPivots, 0) Else working(n, 1) = "MANUAL INPUT" End If End If End If Next n .Range("AL3:AL" & lastrow_SHEETNAME1).Value = working ' .Range("AL2:AL2").AutoFill Destination:=.Range("AL2:AL" & lastrow_SHEETNAME1) ' .Range("AL2:AL" & lastrow_SHEETNAME1).Calculate ' .Range("AL3:AL" & lastrow_SHEETNAME1) = .Range("AL3:AL" & lastrow_SHEETNAME1).Value ' Copy adjustment data. 'zzzz .Range("AM2:AM" & lastrow_SHEETNAME1) = .Range("AL2:AL" & lastrow_SHEETNAME1).Value ' Column AN ' =IF(OR($X2="NON EXIST",$Y2="EXCLUDE"),"NON REPORTABLE",IFERROR(VLOOKUP(A2&" - "&AM2,'Mapping Pivots'!$K$4:$M$1458,2,FALSE), 0)) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_a = Range("A3:A" & lastrow_SHEETNAME1) column_am = Range("AM3:AM" & lastrow_SHEETNAME1) column_k_MappingPivots = Sheets("Mapping Pivots").Range("K4:K" & lastrow_MappingPivots3) column_m_MappingPivots = Sheets("Mapping Pivots").Range("M4:M" & lastrow_MappingPivots3) For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then working(n, 1) = "NON REPORTABLE" Else working(n, 1) = ArrayFind(column_k_MappingPivots, column_a(n, 1) & " - " & column_am(n, 1), column_m_MappingPivots, 0) End If Next n .Range("AN3:AN" & lastrow_SHEETNAME1).Value = working ' .Range("AN2:AN2").AutoFill Destination:=.Range("AN2:AN" & lastrow_SHEETNAME1) ' .Range("AN2:AN" & lastrow_SHEETNAME1).Calculate ' .Range("AN3:AN" & lastrow_SHEETNAME1) = .Range("AN3:AN" & lastrow_SHEETNAME1).Value ' Column AO ' =IF(OR($X2="NON EXIST",$Y2="EXCLUDE"),"NON REPORTABLE",F2/AN2) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_f = Range("F3:F" & lastrow_SHEETNAME1) column_an = Range("AN3:AN" & lastrow_SHEETNAME1) For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then working(n, 1) = "NON REPORTABLE" Else If (column_an(n, 1) = 0) Then ' Can't SHEETNAME1de by zero. working(n, 1) = 0 Else working(n, 1) = column_f(n, 1) / column_an(n, 1) End If End If Next n .Range("AO3:AO" & lastrow_SHEETNAME1).Value = working ' Column AP ' =IF(OR($X2="NON EXIST",$Y2="EXCLUDE"),"NON REPORTABLE",IF(COUNTIF($A$1:A2,A2)>1,"AGGREGATE",SUMIF($A:$A,A2,$AO:$AO)-SUMIF(FinalABC!$A:$A,A2,FinalABC!$K:$K))) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_a = Range("A3:A" & lastrow_SHEETNAME1) column_ao = Range("AO3:AO" & lastrow_SHEETNAME1) column_a_FinalABC = Sheets("FinalABC").Range("A3:A" & lastrow_FinalABC) column_k_FinalABC = Sheets("FinalABC").Range("K3:K" & lastrow_FinalABC) For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then working(n, 1) = "NON REPORTABLE" Else If ArrayCountIf(column_a, column_a(n, 1)) > 1 Then working(n, 1) = "AGGREGATE" Else working(n, 1) = Round(ArraySumIf(column_a, column_a(n, 1), column_ao) - ArraySumIf(column_a_FinalABC, column_a(n, 1), column_k_FinalABC), 2) End If End If Next n .Range("AP3:AP" & lastrow_SHEETNAME1).Value = working ' Column AQ ' =IF(OR($X2="NON EXIST",$Y2="EXCLUDE"),"NON REPORTABLE",T2&" - "& IFERROR(IF(VLOOKUP(R2,Wxxxx!B:Z,24,FALSE)="YES", "VALID", "INVALID"),"INVALID")&" - " & IFERROR(VLOOKUP(R2,Wxxxx!B:Z,25,FALSE),"N") &" - "&K2) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_t = Range("T3:T" & lastrow_SHEETNAME1) column_r = Range("R3:R" & lastrow_SHEETNAME1) column_b_Wxxxx = Sheets("Wxxxx").Range("B3:B" & lastrow_Wxxxx) column_y_Wxxxx = Sheets("Wxxxx").Range("Y3:Y" & lastrow_Wxxxx) column_z_Wxxxx = Sheets("Wxxxx").Range("Z3:Z" & lastrow_Wxxxx) column_k = Range("K3:K" & lastrow_SHEETNAME1) For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then working(n, 1) = "NON REPORTABLE" Else working(n, 1) = column_t(n, 1) & " - " tmp = ArrayFind(column_b_Wxxxx, column_r(n, 1), column_y_Wxxxx, 0) If tmp = "YES" Then working(n, 1) = working(n, 1) & "VALID" & " - " Else working(n, 1) = working(n, 1) & "INVALID" & " - " End If tmp = ArrayFind(column_b_Wxxxx, column_r(n, 1), column_z_Wxxxx, "N") working(n, 1) = working(n, 1) & tmp & " - " & column_k(n, 1) End If Next n .Range("AQ3:AQ" & lastrow_SHEETNAME1).Value = working ' .Range("AQ2:AQ2").AutoFill Destination:=.Range("AQ2:AQ" & lastrow_SHEETNAME1) ' .Range("AQ2:AQ" & lastrow_SHEETNAME1).Calculate ' .Range("AQ3:AQ" & lastrow_SHEETNAME1) = .Range("AQ3:AQ" & lastrow_SHEETNAME1).Value ' Column AR ' =IF(OR($X2="NON EXIST",$Y2="EXCLUDE"),"NON REPORTABLE",IFERROR(VLOOKUP(AQ2,References!$H$1:$K$45,2,FALSE),0)) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_aq = Range("AQ3:AQ" & lastrow_SHEETNAME1) column_h_References = Sheets("References").Range("H3:H" & lastrow_References_adjusted_rate) column_i_References = Sheets("References").Range("I3:I" & lastrow_References_adjusted_rate) For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then working(n, 1) = "NON REPORTABLE" Else working(n, 1) = ArrayFind(column_h_References, column_aq(n, 1), column_i_References, 0) End If Next n .Range("AR3:AR" & lastrow_SHEETNAME1).Value = working ' .Range("AR2:AR2").AutoFill Destination:=.Range("AR2:AR" & lastrow_SHEETNAME1) ' .Range("AR2:AR" & lastrow_SHEETNAME1).Calculate ' .Range("AR3:AR" & lastrow_SHEETNAME1) = .Range("AR3:AR" & lastrow_SHEETNAME1).Value ' Column AS ' =IF(OR($X2="NON EXIST",$Y2="EXCLUDE"),"NON REPORTABLE",IFERROR(VLOOKUP(AQ2,References!$H$1:$K$45,3,FALSE),0)) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_aq = Range("AQ3:AQ" & lastrow_SHEETNAME1) column_h_References = Sheets("References").Range("H3:H" & lastrow_References_adjusted_rate) column_j_References = Sheets("References").Range("J3:J" & lastrow_References_adjusted_rate) For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then working(n, 1) = "NON REPORTABLE" Else working(n, 1) = ArrayFind(column_h_References, column_aq(n, 1), column_j_References, 0) End If Next n .Range("AS3:AS" & lastrow_SHEETNAME1).Value = working ' .Range("AS2:AS2").AutoFill Destination:=.Range("AS2:AS" & lastrow_SHEETNAME1) ' .Range("AS2:AS" & lastrow_SHEETNAME1).Calculate ' .Range("AS3:AS" & lastrow_SHEETNAME1) = .Range("AS3:AS" & lastrow_SHEETNAME1).Value ' Column AT ' =IF(OR($X2="NON EXIST",$Y2="EXCLUDE"),"NON REPORTABLE",IFERROR(VLOOKUP(AQ2,References!$H$1:$K$45,4,FALSE),0)) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_aq = Range("AQ3:AQ" & lastrow_SHEETNAME1) column_h_References = Sheets("References").Range("H3:H" & lastrow_References_adjusted_rate) column_k_References = Sheets("References").Range("K3:K" & lastrow_References_adjusted_rate) For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then working(n, 1) = "NON REPORTABLE" Else working(n, 1) = ArrayFind(column_h_References, column_aq(n, 1), column_k_References, 0) End If Next n .Range("AT3:AT" & lastrow_SHEETNAME1).Value = working ' .Range("AT2:AT2").AutoFill Destination:=.Range("AT2:AT" & lastrow_SHEETNAME1) ' .Range("AT2:AT" & lastrow_SHEETNAME1).Calculate ' .Range("AT3:AT" & lastrow_SHEETNAME1) = .Range("AT3:AT" & lastrow_SHEETNAME1).Value ' Copy adjustment data. 'zzzz .Range("AU2:AU" & lastrow_SHEETNAME1) = .Range("AT2:AT" & lastrow_SHEETNAME1).Value ' Column AV ' =IF(OR($X2="NON EXIST",$Y2="EXCLUDE"),"NON REPORTABLE",IFERROR(VLOOKUP(AD2&" - "&AF2,References!S:W,3,FALSE),0)) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_ad = Range("AD3:AD" & lastrow_SHEETNAME1) column_af = Range("AF3:AF" & lastrow_SHEETNAME1) column_s_References = Sheets("References").Range("S3:S" & lastrow_References_income_type) column_u_References = Sheets("References").Range("U3:U" & lastrow_References_income_type) For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then working(n, 1) = "NON REPORTABLE" Else working(n, 1) = ArrayFind(column_s_References, column_ad(n, 1) & " - " & column_af(n, 1), column_u_References, 0) End If Next n .Range("AV3:AV" & lastrow_SHEETNAME1).Value = working ' .Range("AV2:AV2").AutoFill Destination:=.Range("AV2:AV" & lastrow_SHEETNAME1) ' .Range("AV2:AV" & lastrow_SHEETNAME1).Calculate ' .Range("AV3:AV" & lastrow_SHEETNAME1) = .Range("AV3:AV" & lastrow_SHEETNAME1).Value ' Column AW ' =IF(OR($X2="NON EXIST",$Y2="EXCLUDE"),"NON REPORTABLE",IF(OR(AR2="NO ADJUSTMENT REQUIRED",K2=AU2),"NO ADJUSTMENT REQUIRED","ADJUST FROM "&K2&"% TO "&AU2&"% - BBH REPORTED "&AI2&"%")) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_ar = Range("AR3:AR" & lastrow_SHEETNAME1) column_k = Range("K3:K" & lastrow_SHEETNAME1) column_au = Range("AU3:AU" & lastrow_SHEETNAME1) column_ai = Range("AI3:AI" & lastrow_SHEETNAME1) For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then working(n, 1) = "NON REPORTABLE" Else If (column_ar(n, 1) = "NO ADJUSTMENT REQUIRED" Or column_k(n, 1) = column_au(n, 1)) Then working(n, 1) = "NO ADJUSTMENT REQUIRED" Else working(n, 1) = "ADJUST FROM " & column_k(n, 1) & "% TO " & column_au(n, 1) & "% - BBH REPORTED " & column_ai(n, 1) & "%" End If End If Next n .Range("AW3:AW" & lastrow_SHEETNAME1).Value = working ' Column AX ' =IF(OR($X2="NON EXIST",$Y2="EXCLUDE"),"NON REPORTABLE",IF(R2=530572,"BPB&T IOM",IF(T2="IBGC","BPCI","BPB&T Jersey"))) column_x = Range("X3:X" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_r = Range("R3:R" & lastrow_SHEETNAME1) column_t = Range("T3:T" & lastrow_SHEETNAME1) For n = LBound(working) To UBound(working) If (column_x(n, 1) = "NON EXIST" Or column_y(n, 1) = "EXCLUDE") Then working(n, 1) = "NON REPORTABLE" Else If (column_r(n, 1) = 530572) Then working(n, 1) = "BPB&T IOM" Else If (column_t(n, 1) = "IBGC") Then working(n, 1) = "BPCI" Else working(n, 1) = "BPB&T Jersey" End If End If End If Next n .Range("AX3:AX" & lastrow_SHEETNAME1).Value = working ' Column AY ' =IF(AW2="NO ADJUSTMENT REQUIRED","NO ADJUSTMENT REQUIRED",IF(AW2="NON REPORTABLE","NON REPORTABLE",ROUND((F2*AU2%)-I2,2))) column_aw = Range("AW3:AW" & lastrow_SHEETNAME1) column_f = Range("F3:F" & lastrow_SHEETNAME1) column_au = Range("AU3:AU" & lastrow_SHEETNAME1) column_i = Range("I3:I" & lastrow_SHEETNAME1) For n = LBound(working) To UBound(working) If (column_aw(n, 1) = "NO ADJUSTMENT REQUIRED") Then working(n, 1) = "NO ADJUSTMENT REQUIRED" Else If (column_aw(n, 1) = "NON REPORTABLE") Then working(n, 1) = "NON REPORTABLE" Else working(n, 1) = Round((column_f(n, 1) * column_au(n, 1) / 100) - column_i(n, 1), 2) End If End If Next n .Range("AY3:AY" & lastrow_SHEETNAME1).Value = working ' Column BB ' =IF(ISNA(VLOOKUP(U2,References!$AG:$AG,1,FALSE)),"NO ADJUSTMENT REQUIRED",IF(AW2="NO ADJUSTMENT REQUIRED","NO ADJUSTMENT REQUIRED",IF(AW2="NON REPORTABLE","NON REPORTABLE",IFERROR(VLOOKUP(T2&" - "&AU2,References!$O$2:$Q$5,3,FALSE),0)))) column_u = Range("U3:U" & lastrow_SHEETNAME1) column_ag_References = Sheets("References").Range("AG3:AG" & lastrow_References_allowed_locations) column_aw = Range("AW3:AW" & lastrow_SHEETNAME1) column_t = Range("T3:T" & lastrow_SHEETNAME1) column_au = Range("AU3:AU" & lastrow_SHEETNAME1) column_o_References = Sheets("References").Range("O3:O" & lastrow_References_g3_location) column_q_References = Sheets("References").Range("Q3:Q" & lastrow_References_g3_location) For n = LBound(working) To UBound(working) If ArrayCountIf(column_ag_References, column_u(n, 1)) > 0 Then If column_aw(n, 1) = "NO ADJUSTMENT REQUIRED" Then working(n, 1) = "NO ADJUSTMENT REQUIRED" Else If column_aw(n, 1) = "NON REPORTABLE" Then working(n, 1) = "NON REPORTABLE" Else working(n, 1) = ArrayFind(column_o_References, column_t(n, 1) & " - " & column_au(n, 1), column_q_References, 0) End If End If 'working(n, 1) = Round(ArraySumIf(column_a, column_a(n, 1), column_an) - ArraySumIf(column_a_FinalABC, column_a(n, 1), column_k_FinalABC), 2) Else working(n, 1) = "NO ADJUSTMENT REQUIRED" End If Next n .Range("BB3:BB" & lastrow_SHEETNAME1).Value = working ' .Range("BB2:BB2").AutoFill Destination:=.Range("BB2:BB" & lastrow_SHEETNAME1) ' .Range("BB2:BB" & lastrow_SHEETNAME1).Calculate ' .Range("BB3:BB" & lastrow_SHEETNAME1) = .Range("BB3:BB" & lastrow_SHEETNAME1).Value ' Column BD ' =IF(AW2="NO ADJUSTMENT REQUIRED","NO ADJUSTMENT REQUIRED",IF(AW2="NON REPORTABLE","NON REPORTABLE",IFERROR(VLOOKUP(T2& " - " &AU2,References!$O$2:$Q$5,2,FALSE),0))) column_aw = Range("AW3:AW" & lastrow_SHEETNAME1) column_au = Range("AU3:AU" & lastrow_SHEETNAME1) column_o_References = Sheets("References").Range("O3:O" & lastrow_References_g3_location) column_p_References = Sheets("References").Range("P3:P" & lastrow_References_g3_location) For n = LBound(working) To UBound(working) If (column_aw(n, 1) = "NO ADJUSTMENT REQUIRED") Then working(n, 1) = "NO ADJUSTMENT REQUIRED" Else If (column_aw(n, 1) = "NON REPORTABLE") Then working(n, 1) = "NON REPORTABLE" Else working(n, 1) = ArrayFind(column_o_References, column_t(n, 1) & " - " & column_au(n, 1), column_p_References, 0) End If End If Next n .Range("BD3:BD" & lastrow_SHEETNAME1).Value = working ' .Range("BD2:BD2").AutoFill Destination:=.Range("BD2:BD" & lastrow_SHEETNAME1) ' .Range("BD2:BD" & lastrow_SHEETNAME1).Calculate ' .Range("BD3:BD" & lastrow_SHEETNAME1) = .Range("BD3:BD" & lastrow_SHEETNAME1).Value ' Column BE '=IF(AW2="NO ADJUSTMENT REQUIRED","NO ADJUSTMENT REQUIRED",IF(AW2="NON REPORTABLE","NON REPORTABLE",IF(BD2<>M2,"Yes","No"))) column_aw = Range("AW3:AW" & lastrow_SHEETNAME1) column_bd = Range("BD3:BD" & lastrow_SHEETNAME1) column_m = Range("M3:M" & lastrow_SHEETNAME1) For n = LBound(working) To UBound(working) If (column_aw(n, 1) = "NO ADJUSTMENT REQUIRED") Then working(n, 1) = "NO ADJUSTMENT REQUIRED" Else If (column_aw(n, 1) = "NON REPORTABLE") Then working(n, 1) = "NON REPORTABLE" Else If (column_bd(n, 1) <> column_m(n, 1)) Then working(n, 1) = "Yes" Else working(n, 1) = "No" End If End If End If Next n .Range("BE3:BE" & lastrow_SHEETNAME1).Value = working ' Column BG ' =IF(ISNA(VLOOKUP(R2&N2,HOLDINGS!A:A,1,FALSE)),"NO HOLDINGS","STILL HAS HOLDINGS") column_r = Range("R3:R" & lastrow_SHEETNAME1) column_n = Range("N3:N" & lastrow_SHEETNAME1) column_a_HOLDINGS = Sheets("HOLDINGS").Range("A3:A" & lastrow_HOLDINGS) For n = LBound(working) To UBound(working) working(n, 1) = ArrayFindEx(column_a_HOLDINGS, column_r(n, 1) & column_n(n, 1), "STILL HAS HOLDINGS", "NO HOLDINGS") Next n .Range("BG3:BG" & lastrow_SHEETNAME1).Value = working ' .Range("BG2:BG2").AutoFill Destination:=.Range("BG2:BG" & lastrow_SHEETNAME1) ' .Range("BG2:BG" & lastrow_SHEETNAME1).Calculate ' .Range("BG3:BG" & lastrow_SHEETNAME1) = .Range("BG3:BG" & lastrow_SHEETNAME1).Value ' Column BH '=IF(ISNA(VLOOKUP(R2&N2,HOLDINGS!A:F,6,FALSE)),"NO HOLDINGS",VLOOKUP(R2&N2,HOLDINGS!A:F,6,FALSE)) column_r = Range("R3:R" & lastrow_SHEETNAME1) column_n = Range("N3:N" & lastrow_SHEETNAME1) column_a_HOLDINGS = Sheets("HOLDINGS").Range("A3:A" & lastrow_HOLDINGS) column_f_HOLDINGS = Sheets("HOLDINGS").Range("F3:F" & lastrow_HOLDINGS) For n = LBound(working) To UBound(working) working(n, 1) = ArrayFind(column_a_HOLDINGS, column_r(n, 1) & column_n(n, 1), column_f_HOLDINGS, "NO HOLDINGS") Next n .Range("BH3:BH" & lastrow_SHEETNAME1).Value = working ' .Range("BH2:BH2").AutoFill Destination:=.Range("BH2:BH" & lastrow_SHEETNAME1) ' .Range("BH2:BH" & lastrow_SHEETNAME1).Calculate ' .Range("BH3:BH" & lastrow_SHEETNAME1) = .Range("BH3:BH" & lastrow_SHEETNAME1).Value ' Column BI ' =IF(BH2="NO HOLDINGS","NO HOLDINGS",VLOOKUP(BH2,References!A:B,2,FALSE)) column_bh = Range("BH3:BH" & lastrow_SHEETNAME1) column_a_References = Sheets("References").Range("A3:A" & lastrow_References) column_b_References = Sheets("References").Range("B3:B" & lastrow_References) For n = LBound(working) To UBound(working) If column_bh(n, 1) = "NO HOLDINGS" Then working(n, 1) = "NO HOLDINGS" Else working(n, 1) = ArrayFind(column_a_References, column_bh(n, 1), column_b_References, 0) End If Next n .Range("BI3:BI" & lastrow_SHEETNAME1).Value = working ' .Range("BI2:BI2").AutoFill Destination:=.Range("BI2:BI" & lastrow_SHEETNAME1) ' .Range("BI2:BI" & lastrow_SHEETNAME1).Calculate ' .Range("BI3:BI" & lastrow_SHEETNAME1) = .Range("BI3:BI" & lastrow_SHEETNAME1).Value ' Column BJ ' =IF(OR(BB2="NO ADJUSTMENT REQUIRED",Y2="EXCLUDE"),"NO ADJUSTMENT REQUIRED",IFERROR(VLOOKUP(LEFT(P2,6)&TEXT(H2,"#.00")&R2,TRANSACTIONS!A:L,12,FALSE),0)) column_bb = Range("BB3:BB" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_p = Range("P3:P" & lastrow_SHEETNAME1) column_h = Range("H3:H" & lastrow_SHEETNAME1) column_r = Range("R3:R" & lastrow_SHEETNAME1) column_a_TRANSACTIONS = Sheets("TRANSACTIONS").Range("A3:A" & lastrow_TRANSACTIONS) column_l_TRANSACTIONS = Sheets("TRANSACTIONS").Range("L3:L" & lastrow_TRANSACTIONS) For n = LBound(working) To UBound(working) If column_bb(n, 1) = "NO ADJUSTMENT REQUIRED" Or column_y(n, 1) = "EXCLUDE" Then working(n, 1) = "NO ADJUSTMENT REQUIRED" Else working(n, 1) = ArrayFind(column_a_TRANSACTIONS, Left(column_p(n, 1), 6) & WorksheetFunction.Text(column_h(n, 1), "#.00") & column_r(n, 1), column_l_TRANSACTIONS, 0) End If Next n .Range("BJ3:BJ" & lastrow_SHEETNAME1).Value = working ' .Range("BJ2:BJ2").AutoFill Destination:=.Range("BJ2:BJ" & lastrow_SHEETNAME1) ' .Range("BJ2:BJ" & lastrow_SHEETNAME1).Calculate ' .Range("BJ3:BJ" & lastrow_SHEETNAME1) = .Range("BJ3:BJ" & lastrow_SHEETNAME1).Value ' Column BK ' =IF(OR(BB2="NO ADJUSTMENT REQUIRED",Y2="EXCLUDE"),"NO ADJUSTMENT REQUIRED",VLOOKUP(LEFT(P2,6)&TEXT(H2,"#.00")&R2,TRANSACTIONS!A:M,13,FALSE)) column_bb = Range("BB3:BB" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_p = Range("P3:P" & lastrow_SHEETNAME1) column_h = Range("H3:H" & lastrow_SHEETNAME1) column_r = Range("R3:R" & lastrow_SHEETNAME1) column_a_TRANSACTIONS = Sheets("TRANSACTIONS").Range("A3:A" & lastrow_TRANSACTIONS) column_m_TRANSACTIONS = Sheets("TRANSACTIONS").Range("M3:M" & lastrow_TRANSACTIONS) For n = LBound(working) To UBound(working) If column_bb(n, 1) = "NO ADJUSTMENT REQUIRED" Or column_y(n, 1) = "EXCLUDE" Then working(n, 1) = "NO ADJUSTMENT REQUIRED" Else working(n, 1) = ArrayFind(column_a_TRANSACTIONS, Left(column_p(n, 1), 6) & WorksheetFunction.Text(column_h(n, 1), "#.00") & column_r(n, 1), column_m_TRANSACTIONS, 0) End If Next n .Range("BK3:BK" & lastrow_SHEETNAME1).Value = working ' .Range("BK2:BK2").AutoFill Destination:=.Range("BK2:BK" & lastrow_SHEETNAME1) ' .Range("BK2:BK" & lastrow_SHEETNAME1).Calculate ' .Range("BK3:BK" & lastrow_SHEETNAME1) = .Range("BK3:BK" & lastrow_SHEETNAME1).Value ' Column BL ' =IF(OR(BB2="NO ADJUSTMENT REQUIRED",Y2="EXCLUDE"),"NO ADJUSTMENT REQUIRED",VLOOKUP(LEFT(P2,6)&TEXT(H2,"#.00")&R2,TRANSACTIONS!A:N,14,FALSE)) column_bb = Range("BB3:BB" & lastrow_SHEETNAME1) column_y = Range("Y3:Y" & lastrow_SHEETNAME1) column_p = Range("P3:P" & lastrow_SHEETNAME1) column_h = Range("H3:H" & lastrow_SHEETNAME1) column_r = Range("R3:R" & lastrow_SHEETNAME1) column_a_TRANSACTIONS = Sheets("TRANSACTIONS").Range("A3:A" & lastrow_TRANSACTIONS) column_n_TRANSACTIONS = Sheets("TRANSACTIONS").Range("N3:N" & lastrow_TRANSACTIONS) For n = LBound(working) To UBound(working) If column_bb(n, 1) = "NO ADJUSTMENT REQUIRED" Or column_y(n, 1) = "EXCLUDE" Then working(n, 1) = "NO ADJUSTMENT REQUIRED" Else working(n, 1) = ArrayFind(column_a_TRANSACTIONS, Left(column_p(n, 1), 6) & WorksheetFunction.Text(column_h(n, 1), "#.00") & column_r(n, 1), column_n_TRANSACTIONS, 0) End If Next n .Range("BL3:BL" & lastrow_SHEETNAME1).Value = working ' .Range("BL2:BL2").AutoFill Destination:=.Range("BL2:BL" & lastrow_SHEETNAME1) ' .Range("BL2:BL" & lastrow_SHEETNAME1).Calculate ' .Range("BL3:BL" & lastrow_SHEETNAME1) = .Range("BL3:BL" & lastrow_SHEETNAME1).Value ' Column BM ' =IF(ISNA(VLOOKUP(R2,QSHEET!A:A,1,FALSE)),"NOT ON QSHEET", "ON QSHEET") column_r = Range("R3:R" & lastrow_SHEETNAME1) column_a_QSHEET = Sheets("QSHEET").Range("A3:A" & lastrow_QSHEET) For n = LBound(working) To UBound(working) working(n, 1) = ArrayFindEx(column_a_QSHEET, column_r(n, 1), "ON QSHEET", "NOT ON QSHEET") Next n .Range("BM3:BM" & lastrow_SHEETNAME1).Value = working ' .Range("BM2:BM2").AutoFill Destination:=.Range("BM2:BM" & lastrow_SHEETNAME1) ' .Range("BM2:BM" & lastrow_SHEETNAME1).Calculate ' .Range("BM3:BM" & lastrow_SHEETNAME1) = .Range("BM3:BM" & lastrow_SHEETNAME1).Value End With End With ' Clear all objects. Set working = Nothing Set column_a = Nothing Set column_b = Nothing Set column_e = Nothing Set column_f = Nothing Set column_g = Nothing Set column_h = Nothing Set column_i = Nothing Set column_k = Nothing Set column_m = Nothing Set column_n = Nothing Set column_p = Nothing Set column_r = Nothing Set column_t = Nothing Set column_u = Nothing Set column_x = Nothing Set column_y = Nothing Set column_ab = Nothing Set column_ad = Nothing Set column_af = Nothing Set column_ai = Nothing Set column_aj = Nothing Set column_an = Nothing Set column_ao = Nothing Set column_aq = Nothing Set column_ar = Nothing Set column_au = Nothing Set column_aw = Nothing Set column_bb = Nothing Set column_bd = Nothing Set column_bh = Nothing Set column_a_CUST = Nothing Set column_b_CUST = Nothing Set column_a_FinalABC = Nothing Set column_d_FinalABC = Nothing Set column_k_FinalABC = Nothing Set column_n_FinalABC = Nothing Set column_a_HOLDINGS = Nothing Set column_f_HOLDINGS = Nothing Set column_a_MappingPivots = Nothing Set column_b_MappingPivots = Nothing Set column_c_MappingPivots = Nothing Set column_f_MappingPivots = Nothing Set column_g_MappingPivots = Nothing Set column_h_MappingPivots = Nothing Set column_a_References = Nothing Set column_b_References = Nothing Set column_h_References = Nothing Set column_k_References = Nothing Set column_s_References = Nothing Set column_u_References = Nothing Set column_ag_References = Nothing Set column_a_QSHEET = Nothing Set column_a_TRANSACTIONS = Nothing Set column_l_TRANSACTIONS = Nothing Set column_m_TRANSACTIONS = Nothing Set column_n_TRANSACTIONS = Nothing Set column_b_Wxxxx = Nothing Set column_y_Wxxxx = Nothing Set column_z_Wxxxx = Nothing Set prev_a = Nothing Set prev_b = Nothing Set prev_c = Nothing Set prev_f = Nothing Set prev_g = Nothing Set prev_h = Nothing Set tmp = Nothing End Sub ' Copies remaining formulae down on the SHEETNAME1 sheet. Sub M10625_Recalc_SHEETNAME1_Formulae() Dim lastrow_SHEETNAME1 As Long Dim lastrow_FinalABC As Long Dim top_row As Integer Dim source As String Dim SHEETNAME1_range As Range Dim FinalABC_range As Range ' Set top row for pivots. ' top_row is row in which pivots at the top are created. top_row = 5 ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Recalc SHEETNAME1 PIVOT formulae?", vbYesNo) = vbNo Then Exit Sub End If 'Creating Pivot cache On Error Resume Next With Workbooks(wb_name) ' Get how many rows of data have been loaded into the sheet. 'lastrow = Workbooks(my1042Rec).Sheets("SHEETNAME1").Range("D65536").End(xlUp).Row lastrow_SHEETNAME1 = .Sheets("SHEETNAME1").Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_SHEETNAME1 < 3 Then lastrow_SHEETNAME1 = 3 End If ' Get how many rows of data have been loaded into the sheet. 'SHEETNAME1_lastrow = Workbooks(my1042Rec).Sheets("SHEETNAME1").Cells(Rows.Count, 4).End(xlUp).Row lastrow_FinalABC = .Sheets("FinalABC").Cells(Rows.Count, 4).End(xlUp).Row Set SHEETNAME1_range = Range("SHEETNAME1!A1:BO" & lastrow_SHEETNAME1) Set FinalABC_range = Range("FinalABC!A1:AT" & lastrow_FinalABC) With .Sheets("SHEETNAME1") ' Activate the sheet. .Activate ' Select A1. ScrollTo ActiveSheet.name, "A1" .Range("X2:X2").AutoFill Destination:=.Range("X2:X" & lastrow_SHEETNAME1) .Range("X2:X" & lastrow_SHEETNAME1).Calculate .Range("X3:X" & lastrow_SHEETNAME1) = .Range("X3:X" & lastrow_SHEETNAME1).Value .Range("AB2:AB2").AutoFill Destination:=.Range("AB2:AB" & lastrow_SHEETNAME1) .Range("AB2:AB" & lastrow_SHEETNAME1).Calculate .Range("AB3:AB" & lastrow_SHEETNAME1) = .Range("AB3:AB" & lastrow_SHEETNAME1).Value .Range("AC2:AC2").AutoFill Destination:=.Range("AC2:AC" & lastrow_SHEETNAME1) .Range("AC2:AC" & lastrow_SHEETNAME1).Calculate .Range("AC3:AC" & lastrow_SHEETNAME1) = .Range("AC3:AC" & lastrow_SHEETNAME1).Value ' Copy adjustment data. 'zzzz .Range("AD2:AD" & lastrow_SHEETNAME1) = .Range("AC2:AC" & lastrow_SHEETNAME1).Value .Range("AE2:AE2").AutoFill Destination:=.Range("AE2:AE" & lastrow_SHEETNAME1) .Range("AE2:AE" & lastrow_SHEETNAME1).Calculate .Range("AE3:AE" & lastrow_SHEETNAME1) = .Range("AE3:AE" & lastrow_SHEETNAME1).Value ' Copy adjustment data. 'zzzz .Range("AF2:AF" & lastrow_SHEETNAME1) = .Range("AE2:AE" & lastrow_SHEETNAME1).Value .Range("AG2:AG2").AutoFill Destination:=.Range("AG2:AG" & lastrow_SHEETNAME1) .Range("AG2:AG" & lastrow_SHEETNAME1).Calculate .Range("AG3:AG" & lastrow_SHEETNAME1) = .Range("AG3:AG" & lastrow_SHEETNAME1).Value .Range("AH2:AH2").AutoFill Destination:=.Range("AH2:AH" & lastrow_SHEETNAME1) .Range("AH2:AH" & lastrow_SHEETNAME1).Calculate .Range("AH3:AH" & lastrow_SHEETNAME1) = .Range("AH3:AH" & lastrow_SHEETNAME1).Value ' Copy adjustment data. 'zzzz .Range("AI2:AI" & lastrow_SHEETNAME1) = .Range("AH2:AH" & lastrow_SHEETNAME1).Value .Range("AJ2:AJ2").AutoFill Destination:=.Range("AJ2:AJ" & lastrow_SHEETNAME1) .Range("AJ2:AJ" & lastrow_SHEETNAME1).Calculate .Range("AJ3:AJ" & lastrow_SHEETNAME1) = .Range("AJ3:AJ" & lastrow_SHEETNAME1).Value ' Depends on the earlier pivots. .Range("AK2:AK2").AutoFill Destination:=.Range("AK2:AK" & lastrow_SHEETNAME1) .Range("AK2:AK" & lastrow_SHEETNAME1).Calculate .Range("AK3:AK" & lastrow_SHEETNAME1) = .Range("AK3:AK" & lastrow_SHEETNAME1).Value .Range("AL2:AL2").AutoFill Destination:=.Range("AL2:AL" & lastrow_SHEETNAME1) .Range("AL2:AL" & lastrow_SHEETNAME1).Calculate .Range("AL3:AL" & lastrow_SHEETNAME1) = .Range("AL3:AL" & lastrow_SHEETNAME1).Value ' Copy adjustment data. 'zzzz .Range("AM2:AM" & lastrow_SHEETNAME1) = .Range("AL2:AL" & lastrow_SHEETNAME1).Value .Range("AN2:AN2").AutoFill Destination:=.Range("AN2:AN" & lastrow_SHEETNAME1) .Range("AN2:AN" & lastrow_SHEETNAME1).Calculate .Range("AN3:AN" & lastrow_SHEETNAME1) = .Range("AN3:AN" & lastrow_SHEETNAME1).Value .Range("AO2:AO2").AutoFill Destination:=.Range("AO2:AO" & lastrow_SHEETNAME1) .Range("AO2:AO" & lastrow_SHEETNAME1).Calculate .Range("AO3:AO" & lastrow_SHEETNAME1) = .Range("AO3:AO" & lastrow_SHEETNAME1).Value .Range("AP2:AP2").AutoFill Destination:=.Range("AP2:AP" & lastrow_SHEETNAME1) .Range("AP2:AP" & lastrow_SHEETNAME1).Calculate .Range("AP3:AP" & lastrow_SHEETNAME1) = .Range("AP3:AP" & lastrow_SHEETNAME1).Value .Range("AQ2:AQ2").AutoFill Destination:=.Range("AQ2:AQ" & lastrow_SHEETNAME1) .Range("AQ2:AQ" & lastrow_SHEETNAME1).Calculate .Range("AQ3:AQ" & lastrow_SHEETNAME1) = .Range("AQ3:AQ" & lastrow_SHEETNAME1).Value .Range("AR2:AR2").AutoFill Destination:=.Range("AR2:AR" & lastrow_SHEETNAME1) .Range("AR2:AR" & lastrow_SHEETNAME1).Calculate .Range("AR3:AR" & lastrow_SHEETNAME1) = .Range("AR3:AR" & lastrow_SHEETNAME1).Value .Range("AS2:AS2").AutoFill Destination:=.Range("AS2:AS" & lastrow_SHEETNAME1) .Range("AS2:AS" & lastrow_SHEETNAME1).Calculate .Range("AS3:AS" & lastrow_SHEETNAME1) = .Range("AS3:AS" & lastrow_SHEETNAME1).Value .Range("AT2:AT2").AutoFill Destination:=.Range("AT2:AT" & lastrow_SHEETNAME1) .Range("AT2:AT" & lastrow_SHEETNAME1).Calculate .Range("AT3:AT" & lastrow_SHEETNAME1) = .Range("AT3:AT" & lastrow_SHEETNAME1).Value ' Copy adjustment data. 'zzzz .Range("AU2:AU" & lastrow_SHEETNAME1) = .Range("AT2:AT" & lastrow_SHEETNAME1).Value .Range("AV2:AV2").AutoFill Destination:=.Range("AV2:AV" & lastrow_SHEETNAME1) .Range("AV2:AV" & lastrow_SHEETNAME1).Calculate .Range("AV3:AV" & lastrow_SHEETNAME1) = .Range("AV3:AV" & lastrow_SHEETNAME1).Value .Range("AW2:AW2").AutoFill Destination:=.Range("AW2:AW" & lastrow_SHEETNAME1) .Range("AW2:AW" & lastrow_SHEETNAME1).Calculate .Range("AW3:AW" & lastrow_SHEETNAME1) = .Range("AW3:AW" & lastrow_SHEETNAME1).Value .Range("AX2:AX2").AutoFill Destination:=.Range("AX2:AX" & lastrow_SHEETNAME1) .Range("AX2:AX" & lastrow_SHEETNAME1).Calculate .Range("AX3:AX" & lastrow_SHEETNAME1) = .Range("AX3:AX" & lastrow_SHEETNAME1).Value .Range("AY2:AY2").AutoFill Destination:=.Range("AY2:AY" & lastrow_SHEETNAME1) .Range("AY2:AY" & lastrow_SHEETNAME1).Calculate .Range("AY3:AY" & lastrow_SHEETNAME1) = .Range("AY3:AY" & lastrow_SHEETNAME1).Value .Range("BB2:BB2").AutoFill Destination:=.Range("BB2:BB" & lastrow_SHEETNAME1) .Range("BB2:BB" & lastrow_SHEETNAME1).Calculate .Range("BB3:BB" & lastrow_SHEETNAME1) = .Range("BB3:BB" & lastrow_SHEETNAME1).Value .Range("BD2:BD2").AutoFill Destination:=.Range("BD2:BD" & lastrow_SHEETNAME1) .Range("BD2:BD" & lastrow_SHEETNAME1).Calculate .Range("BD3:BD" & lastrow_SHEETNAME1) = .Range("BD3:BD" & lastrow_SHEETNAME1).Value .Range("BE2:BE2").AutoFill Destination:=.Range("BE2:BE" & lastrow_SHEETNAME1) .Range("BE2:BE" & lastrow_SHEETNAME1).Calculate .Range("BE3:BE" & lastrow_SHEETNAME1) = .Range("BE3:BE" & lastrow_SHEETNAME1).Value .Range("BG2:BG2").AutoFill Destination:=.Range("BG2:BG" & lastrow_SHEETNAME1) .Range("BG2:BG" & lastrow_SHEETNAME1).Calculate .Range("BG3:BG" & lastrow_SHEETNAME1) = .Range("BG3:BG" & lastrow_SHEETNAME1).Value .Range("BH2:BH2").AutoFill Destination:=.Range("BH2:BH" & lastrow_SHEETNAME1) .Range("BH2:BH" & lastrow_SHEETNAME1).Calculate .Range("BH3:BH" & lastrow_SHEETNAME1) = .Range("BH3:BH" & lastrow_SHEETNAME1).Value .Range("BI2:BI2").AutoFill Destination:=.Range("BI2:BI" & lastrow_SHEETNAME1) .Range("BI2:BI" & lastrow_SHEETNAME1).Calculate .Range("BI3:BI" & lastrow_SHEETNAME1) = .Range("BI3:BI" & lastrow_SHEETNAME1).Value .Range("BJ2:BJ2").AutoFill Destination:=.Range("BJ2:BJ" & lastrow_SHEETNAME1) .Range("BJ2:BJ" & lastrow_SHEETNAME1).Calculate .Range("BJ3:BJ" & lastrow_SHEETNAME1) = .Range("BJ3:BJ" & lastrow_SHEETNAME1).Value .Range("BK2:BK2").AutoFill Destination:=.Range("BK2:BK" & lastrow_SHEETNAME1) .Range("BK2:BK" & lastrow_SHEETNAME1).Calculate .Range("BK3:BK" & lastrow_SHEETNAME1) = .Range("BK3:BK" & lastrow_SHEETNAME1).Value .Range("BL2:BL2").AutoFill Destination:=.Range("BL2:BL" & lastrow_SHEETNAME1) .Range("BL2:BL" & lastrow_SHEETNAME1).Calculate .Range("BL3:BL" & lastrow_SHEETNAME1) = .Range("BL3:BL" & lastrow_SHEETNAME1).Value .Range("BM2:BM2").AutoFill Destination:=.Range("BM2:BM" & lastrow_SHEETNAME1) .Range("BM2:BM" & lastrow_SHEETNAME1).Calculate .Range("BM3:BM" & lastrow_SHEETNAME1) = .Range("BM3:BM" & lastrow_SHEETNAME1).Value End With End With ' Clear all objects. Set SHEETNAME1_range = Nothing Set FinalABC_range = Nothing End Sub ' Format the FinalABC sheet to put lines between ISINs. Sub M10700_Format_FinalABC_lines() Dim myISIN_Change As Variant Dim lastrow_FinalABC As Long ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Format the FinalABC sheet to put lines between ISIN's?", vbYesNo) = vbNo Then Exit Sub End If With Workbooks(wb_name) ' Get how many rows of data have been loaded into the sheet. 'lastrow = Workbooks(my1042Rec).Sheets("FinalABC").Range("D65536").End(xlUp).Row lastrow_FinalABC = .Sheets("FinalABC").Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_FinalABC < 3 Then lastrow_FinalABC = 3 End If With .Sheets("FinalABC") ' Activate the sheet. .Activate ' Calculate first to ensure that we know when there is a change to the ISIN. 'Application.Calculate '.Range("AJ2:AJ" & lastrow_FinalABC).Calculate .Range("AJ2:AJ2").AutoFill Destination:=.Range("AJ2:AJ" & lastrow_FinalABC) .Range("AJ2:AJ" & lastrow_FinalABC).Calculate .Range("AJ3:AJ" & lastrow_FinalABC) = .Range("AJ3:AJ" & lastrow_FinalABC).Value ' For Each myISIN_Change In .Range("AJ2", Range("AJ65536").End(xlUp)) For Each myISIN_Change In .Range("AJ2:AJ" & lastrow_FinalABC) If myISIN_Change = False Then .Range("A" & myISIN_Change.Row & ":AT" & myISIN_Change.Row).Select With Selection.Borders(xlEdgeTop) .LineStyle = xlDouble .Color = -4165632 .TintAndShade = 0 .Weight = xlThick End With End If Next myISIN_Change End With End With ' Clear all objects. Set myISIN_Change = Nothing End Sub ' Format the SHEETNAME1 sheet by placing lines between ISINs. Sub M10710_Format_SHEETNAME1_Lines() Dim lastrow_SHEETNAME1 As Long Dim myISIN_Change As Variant ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Format the SHEETNAME1 sheet to put lines between ISIN's?", vbYesNo) = vbNo Then Exit Sub End If With Workbooks(wb_name) ' Get how many rows of data have been loaded into the sheet. lastrow_SHEETNAME1 = .Sheets("SHEETNAME1").Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_SHEETNAME1 < 3 Then lastrow_SHEETNAME1 = 3 End If With .Sheets("SHEETNAME1") ' Activate the sheet. .Activate ' Application.Calculate '.Range("W2:W" & lastrow_SHEETNAME1).Calculate .Range("W2:W2").AutoFill Destination:=.Range("W2:W" & lastrow_SHEETNAME1) .Range("W2:W" & lastrow_SHEETNAME1).Calculate .Range("W3:W" & lastrow_SHEETNAME1) = .Range("W3:W" & lastrow_SHEETNAME1).Value ' For Each myISIN_Change In .Range("W2", Range("W65536").End(xlUp)) For Each myISIN_Change In .Range("W2:W" & lastrow_SHEETNAME1) If myISIN_Change = False Then .Range("A" & myISIN_Change.Row & ":BO" & myISIN_Change.Row).Select With Selection.Borders(xlEdgeTop) .LineStyle = xlDouble .Color = -4165632 .TintAndShade = 0 .Weight = xlThick End With End If Next myISIN_Change End With End With ' Clear all objects. Set myISIN_Change = Nothing End Sub ' Refresh the PIVOT tables on the REC DASHBOARD sheet. Sub M10800_Refresh_Rec_Dashboard_Pivots() Dim lastrow_SHEETNAME1 As Long Dim lastrow_FinalABC As Long Dim pc As PivotCache Dim pt As PivotTable Dim top_row As Integer Dim bottom_row As Integer ' Set top and bottom row for pivots. ' top_row is row in which pivots at the top are created. ' bottom_row is row in which pivots below are created. top_row = 5 bottom_row = 20 ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Refresh Rec Dashboard Pivots?", vbYesNo) = vbNo Then Exit Sub End If ' Stop alerts about replacing contents of cells. Application.DisplayAlerts = False With Workbooks(wb_name) ' Get how many rows of data have been loaded into the sheet. 'lastrow = Workbooks(my1042Rec).Sheets("FinalABC").Range("D65536").End(xlUp).Row lastrow_FinalABC = .Sheets("FinalABC").Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_FinalABC < 3 Then lastrow_FinalABC = 3 End If lastrow_SHEETNAME1 = .Sheets("SHEETNAME1").Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_SHEETNAME1 < 3 Then lastrow_SHEETNAME1 = 3 End If With Sheets("REC DASHBOARD") ' Activate the sheet. .Activate ' Delete all existing Pivot Tables in the worksheet. ' In the TableRange1 property, page fields are excluded; ' To select the entire PivotTable report, including the page fields, use the TableRange2 property. For Each pt In .PivotTables pt.TableRange2.Clear Next pt '**************************** BBH PIVOT Gross Totals ********************** ' Creating Pivot cache. Set pc = ActiveWorkbook.PivotCaches.Create(xlDatabase, "FinalABC!A1:AT" & lastrow_FinalABC) ' Creating Pivot table. Set pt = pc.CreatePivotTable(.Range("A" & top_row), "PivotTableBBHRec") ' Set the Pivot fields to display. With pt ' Turn off automatic updation of Pivot Table during the process of its creation to speed up code. .ManualUpdate = True '.Orientation = xlPageField '.Orientation = xlColumnField ' Set row field. With .PivotFields("Account") 'pvi = .PivotItems("1") '.PivotItems("Row Label").Caption = "Account" .Orientation = xlRowField .Position = 1 End With ' Set column field. 'With .PivotFields("Region") ' .Orientation = xlColumnField ' .Position = 1 'End With ' Set data field. '.AddDataField .PivotFields("Gross CCY Converted"), "Sum of Gross CCY Converted", xlSum ' Set data field. With .PivotFields("Gross CCY Converted") .Orientation = xlDataField .Function = xlSum .NumberFormat = "#,##0" .Position = 1 End With ' Turn on automatic update / calculation in the Pivot Table. .ManualUpdate = False ' Get the actual data. .RefreshTable ' Make the Grand Total yellow. .PivotSelect name:="Column Grand Total", Mode:=xlDataAndLabel, UseStandardName:=True Selection.Interior.Color = vbYellow End With '**************************** SHEETNAME1 PIVOT Gross Totals ********************** ' Creating Pivot cache. Set pc = ActiveWorkbook.PivotCaches.Create(xlDatabase, "SHEETNAME1!A1:BO" & lastrow_SHEETNAME1) ' Creating Pivot table. 'Set pt = pc.CreatePivotTable(ws.Range("A17")) Set pt = pc.CreatePivotTable(.Range("A" & bottom_row), "PivotTableSHEETNAME1Rec") ' Set the Pivot fields to display. With pt ' Turn off automatic updation of Pivot Table during the process of its creation to speed up code. .ManualUpdate = True ' Set row field. With .PivotFields("Pool Account BBH") '.Caption = "Account" .Orientation = xlRowField .Position = 1 End With ' Set data field. With .PivotFields("Gross Payment To Include") .Orientation = xlDataField .Function = xlSum .NumberFormat = "#,##0" .Position = 1 End With ' Turn on automatic update / calculation in the Pivot Table. .ManualUpdate = False ' Get the actual data. .RefreshTable ' Make the Grand Total yellow. .PivotSelect name:="Column Grand Total", Mode:=xlDataAndLabel, UseStandardName:=True Selection.Interior.Color = vbYellow End With '**************************** BBH PIVOT "INCOME & EXEMPTION TOTALS" ********************** ' Creating Pivot cache. Set pc = ActiveWorkbook.PivotCaches.Create(xlDatabase, "FinalABC!A1:AT" & lastrow_FinalABC) ' Creating Pivot table. Set pt = pc.CreatePivotTable(.Range("I" & top_row), "PivotTableBBH_IncomeRec") ' Set the Pivot fields to display. With pt ' Set tabular form for entire pivot table. '.RowAxisLayout xlTabularRow ' Turn off automatic updation of Pivot Table during the process of its creation to speed up code. .ManualUpdate = True ' Set row field. With .PivotFields("INC_CDE") .Orientation = xlRowField .Position = 1 .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) .LayoutForm = xlTabular End With With .PivotFields("NRA_Exm_Cde") .Orientation = xlRowField .Position = 2 .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) .LayoutForm = xlTabular End With ' Set data field. With .PivotFields("Gross CCY Converted") .Orientation = xlDataField .Function = xlSum .NumberFormat = "#,##0" .Position = 1 End With ' Turn on automatic update / calculation in the Pivot Table. .ManualUpdate = False ' Get the actual data. .RefreshTable ' Make the Grand Total yellow. .PivotSelect name:="Column Grand Total", Mode:=xlDataAndLabel, UseStandardName:=True Selection.Interior.Color = vbYellow End With '**************************** SHEETNAME1 PIVOT "INCOME & EXEMPTION TOTALS" ********************** ' Creating Pivot cache. Set pc = ActiveWorkbook.PivotCaches.Create(xlDatabase, "SHEETNAME1!A1:BO" & lastrow_SHEETNAME1) ' Creating Pivot table. 'Set pt = pc.CreatePivotTable(ws.Range("A17")) Set pt = pc.CreatePivotTable(.Range("I" & bottom_row), "PivotTableSHEETNAME1_IncomeRec") ' Set the Pivot fields to display. With pt ' Turn off automatic updation of Pivot Table during the process of its creation to speed up code. .ManualUpdate = True ' Set row field. With .PivotFields("Income Code Adjusted") .Orientation = xlRowField .Position = 1 .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) .LayoutForm = xlTabular End With With .PivotFields("Exemption Code Adjusted") .Orientation = xlRowField .Position = 2 .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) .LayoutForm = xlTabular End With ' Set data field. With .PivotFields("Gross Payment To Include") .Orientation = xlDataField .Function = xlSum .NumberFormat = "#,##0" .Position = 1 End With ' Turn on automatic update / calculation in the Pivot Table. .ManualUpdate = False ' Get the actual data. .RefreshTable ' Make the Grand Total yellow. .PivotSelect name:="Column Grand Total", Mode:=xlDataAndLabel, UseStandardName:=True Selection.Interior.Color = vbYellow End With '**************************** BBH PIVOT "CCY TOTALS" ********************** ' Creating Pivot cache. Set pc = ActiveWorkbook.PivotCaches.Create(xlDatabase, "FinalABC!A1:AT" & lastrow_FinalABC) ' Creating Pivot table. Set pt = pc.CreatePivotTable(.Range("S" & top_row), "PivotTableBBH_CCYRec") ' Set the Pivot fields to display. With pt ' Set tabular form for entire pivot table. '.RowAxisLayout xlTabularRow ' Turn off automatic updation of Pivot Table during the process of its creation to speed up code. .ManualUpdate = True ' Set row field. With .PivotFields("PMT_Curr") .Orientation = xlRowField .Position = 1 .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) .LayoutForm = xlTabular End With ' Set data field. With .PivotFields("USD Gross Amount Adjusted") .Orientation = xlDataField .Function = xlSum .NumberFormat = "#,##0" .Position = 1 End With ' Turn on automatic update / calculation in the Pivot Table. .ManualUpdate = False ' Get the actual data. .RefreshTable ' Make the Grand Total yellow. .PivotSelect name:="Column Grand Total", Mode:=xlDataAndLabel, UseStandardName:=True Selection.Interior.Color = vbYellow End With '**************************** SHEETNAME1 PIVOT "CCY TOTALS" ********************** ' Creating Pivot cache. Set pc = ActiveWorkbook.PivotCaches.Create(xlDatabase, "SHEETNAME1!A1:BO" & lastrow_SHEETNAME1) ' Creating Pivot table. 'Set pt = pc.CreatePivotTable(ws.Range("A17")) Set pt = pc.CreatePivotTable(.Range("S" & bottom_row), "PivotTableSHEETNAME1_CCYRec") ' Set the Pivot fields to display. With pt ' Turn off automatic updation of Pivot Table during the process of its creation to speed up code. .ManualUpdate = True ' Set row field. With .PivotFields("BBH CCY Adjusted") .Orientation = xlRowField .Position = 1 .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) .LayoutForm = xlTabular End With ' Set data field. With .PivotFields("USD Gross Converted") .Orientation = xlDataField .Function = xlSum .NumberFormat = "#,##0" .Position = 1 End With ' Turn on automatic update / calculation in the Pivot Table. .ManualUpdate = False ' Get the actual data. .RefreshTable ' Make the Grand Total yellow. .PivotSelect name:="Column Grand Total", Mode:=xlDataAndLabel, UseStandardName:=True Selection.Interior.Color = vbYellow End With '**************************** SHEETNAME1 PIVOT "FINAL REPORTS" ********************** ' Creating Pivot cache. Set pc = ActiveWorkbook.PivotCaches.Create(xlDatabase, "SHEETNAME1!A1:BO" & lastrow_SHEETNAME1) ' Creating Pivot table. 'Set pt = pc.CreatePivotTable(ws.Range("A17")) Set pt = pc.CreatePivotTable(.Range("AA" & top_row), "PivotTableSHEETNAME1_FinalRec") ' Set the Pivot fields to display. With pt ' Turn off automatic updation of Pivot Table during the process of its creation to speed up code. .ManualUpdate = True ' Set row field. With .PivotFields("QI Entity") .Orientation = xlRowField .Position = 1 '.Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) 'set Index 1 (Automatic) to True which sets all other values to False: .Subtotals(1) = True .LayoutForm = xlTabular End With With .PivotFields("Income Code Adjusted") .Orientation = xlRowField .Position = 2 .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) .LayoutForm = xlTabular End With With .PivotFields("Exemption Code Adjusted") .Orientation = xlRowField .Position = 3 .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) .LayoutForm = xlTabular End With With .PivotFields("Suggested Rate Adjusted") .Orientation = xlRowField .Position = 4 .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) .LayoutForm = xlTabular End With ' Set data field. With .PivotFields("USD Gross Converted") .Orientation = xlDataField .Function = xlSum .NumberFormat = "#,##0" .Position = 1 End With ' Turn on automatic update / calculation in the Pivot Table. .ManualUpdate = False ' Get the actual data. .RefreshTable ' Make the Grand Total yellow. .PivotSelect name:="Column Grand Total", Mode:=xlDataAndLabel, UseStandardName:=True Selection.Interior.Color = vbYellow ' Make QI Entity headings green .PivotSelect "QI Entity[All]", xlDataAndLabel, True Selection.Interior.Color = RGB(204, 255, 204) ' Make QI Entity Sub totals yellow. .PivotSelect "QI Entity[All;Total]", xlDataAndLabel, True Selection.Interior.Color = RGB(255, 255, 153) End With ' ***** END PIVOT CREATION **** END PIVOT CREATION *** ' Refresh the pivot tables. For Each pt In .PivotTables pt.RefreshTable pt.Update Next ' Put text to display on the sheet. ' Some text was overwritten by the pivot creation. ' Other text is to replace the "Row Labels" fieldname that Excel 2007 automatically uses. .Range("A" & top_row).Value = "Account" .Range("A" & bottom_row - 2).Value = "G3" .Range("A" & bottom_row - 2).Font.Bold = True .Range("A" & bottom_row).Value = "Account" .Range("I" & top_row).Value = "INC_CDE" .Range("I" & bottom_row - 2).Value = "G3" .Range("I" & bottom_row - 2).Font.Bold = True .Range("I" & bottom_row).Value = "Income Code Adjusted" .Range("S" & top_row).Value = "PMT_Curr" .Range("S" & bottom_row - 2).Value = "G3" .Range("S" & bottom_row - 2).Font.Bold = True .Range("S" & bottom_row).Value = "BBH CCY Converted" .Range("AA" & top_row).Value = "QI Entity" ' Select A1. ScrollTo ActiveSheet.name, "A1" End With End With ' Clear all objects. Set pt = Nothing Set pc = Nothing End Sub ' Refresh the PIVOT tables on the ADJ DASHBOARD sheet. Sub M10810_Refresh_Adj_Dashboard_Pivots() Dim lastrow_SHEETNAME1 As Long Dim pc As PivotCache Dim pt As PivotTable Dim top_row As Integer Dim bottom_row As Integer ' Set top and bottom row for pivots. ' top_row is row in which pivots at the top are created. ' bottom_row is row in which pivots below are created. top_row = 5 bottom_row = 20 ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Refresh Adj Dashboard Pivots?", vbYesNo) = vbNo Then Exit Sub End If ' Stop alerts about replacing contents of cells. Application.DisplayAlerts = False With Workbooks(wb_name) ' Get how many rows of data have been loaded into the sheet. lastrow_SHEETNAME1 = .Sheets("SHEETNAME1").Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_SHEETNAME1 < 3 Then lastrow_SHEETNAME1 = 3 End If With Sheets("ADJ DASHBOARD") ' Activate the sheet. .Activate ' Delete all existing Pivot Tables in the worksheet. ' In the TableRange1 property, page fields are excluded; ' To select the entire PivotTable report, including the page fields, use the TableRange2 property. For Each pt In .PivotTables pt.TableRange2.Clear Next pt '**************************** REPORTING ADJUSTMENT SUMMARY ********************** ' Creating Pivot cache. Set pc = ActiveWorkbook.PivotCaches.Create(xlDatabase, "SHEETNAME1!A1:BO" & lastrow_SHEETNAME1) ' Creating Pivot table. 'Set pt = pc.CreatePivotTable(ws.Range("A17")) Set pt = pc.CreatePivotTable(.Range("A" & top_row), "PivotTableSHEETNAME1") ' Set the Pivot fields to display. With pt ' Turn off automatic updation of Pivot Table during the process of its creation to speed up code. .ManualUpdate = True ' Set row field. With .PivotFields("BBH Income Type") .Orientation = xlRowField .Position = 1 .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) .LayoutForm = xlTabular End With With .PivotFields("Adjustment Description") .Orientation = xlRowField .Position = 2 .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) .LayoutForm = xlTabular End With ' Set column field. 'With .PivotFields("USD Gross") ' .Orientation = xlColumnField ' .Position = 1 ' .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) ' .LayoutForm = xlTabular 'End With 'With .PivotFields("Vol of Transactions") ' .Orientation = xlColumnField ' .Position = 1 ' .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) ' .LayoutForm = xlTabular 'End With ' Set data field. With .PivotFields("USD Gross Converted") .Orientation = xlDataField .Function = xlSum .NumberFormat = "#,##0" .Position = 1 End With 'With .PivotFields("Vol of Transactions") With .PivotFields("Client Code") .Orientation = xlDataField .Function = xlCount .NumberFormat = "#,##0" .Position = 2 End With ' Turn on automatic update / calculation in the Pivot Table. .ManualUpdate = False ' Get the actual data. .RefreshTable ' Make BBH Income Type headings green ' .PivotSelect "USD Gross Converted[All;Total]", xlDataAndLabel, True ' Selection.Interior.Color = RGB(204, 255, 204) ' Make the Grand Total yellow. .PivotSelect name:="Column Grand Total", Mode:=xlDataAndLabel, UseStandardName:=True Selection.Interior.Color = vbYellow End With ' ***** END PIVOT CREATION **** END PIVOT CREATION *** ' Refresh the pivot tables. For Each pt In .PivotTables pt.RefreshTable pt.Update Next ' Put text to display on the sheet. ' Some text was overwritten by the pivot creation. ' Other text is to replace the "Row Labels" fieldname that Excel 2007 automatically uses. .Range("A" & top_row + 1).Value = "BBH Income Type" ' Select A1. ScrollTo ActiveSheet.name, "A1" End With End With ' Clear all objects. Set pt = Nothing Set pc = Nothing End Sub ' Reverts the Corrected Date, column E, in the FinalABC sheet back to its original calculated date. ' It only does this for cells where column AJ does not still reconciles, i.e. does not show "MATCHED GROSS AMOUNT ISIN BY MONTH". ' This requires the following columns to have formulae throughout: E, L, K, AI, AJ Sub M10910_Revert_Reformatted_FinalABC_Corrected_Dates() Dim lastrow_FinalABC As Long ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Revert Reformatted FinalABC Corrected Dates?", vbYesNo) = vbNo Then Exit Sub End If With Workbooks(wb_name) With .Sheets("FinalABC") ' Activate the sheet. .Activate ' Get how many rows of data have been loaded into the sheet. 'lastrow = Workbooks(my1042Rec).Sheets("FinalABC").Range("D65536").End(xlUp).Row lastrow_FinalABC = .Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_FinalABC < 3 Then lastrow_FinalABC = 3 End If ' Change for formula in column E to add 1 to the date. ' This should make dates that are the last day of the month now reflect the 1st of the following month. .Range("E2").Formula = "=TEXT(MID(F2,FIND("" "",F2)+1,FIND("","",F2)-FIND("" "",F2)-1)&"" ""&LEFT(F2,FIND("" "",F2)-1)&"" ""&RIGHT(F2,4),""dd/mm/yyyy"")" ' Copies formulae down. .Range("A2:C2").AutoFill Destination:=.Range("A2:C" & lastrow_FinalABC) .Range("E2").AutoFill Destination:=.Range("E2:E" & lastrow_FinalABC) .Range("K2:N2").AutoFill Destination:=.Range("K2:N" & lastrow_FinalABC) .Range("P2:Q2").AutoFill Destination:=.Range("P2:Q" & lastrow_FinalABC) .Range("AI2:AM2").AutoFill Destination:=.Range("AI2:AM" & lastrow_FinalABC) .Range("AR2:AT2").AutoFill Destination:=.Range("AR2:AT" & lastrow_FinalABC) ' Calculations. .Range("E2:E" & lastrow_FinalABC).Calculate .Range("A2:C" & lastrow_FinalABC).Calculate .Range("P2:Q" & lastrow_FinalABC).Calculate .Range("K2:N" & lastrow_FinalABC).Calculate .Range("AI2:AM" & lastrow_FinalABC).Calculate .Range("AR2:AT" & lastrow_FinalABC).Calculate ' Now copy and paste formula ranges as values to speed up the file processing. .Range("E3:E" & lastrow_FinalABC) = .Range("E3:E" & lastrow_FinalABC).Value .Range("A3:A" & lastrow_FinalABC) = .Range("A3:A" & lastrow_FinalABC).Value .Range("K3:N" & lastrow_FinalABC) = .Range("K3:L" & lastrow_FinalABC).Value .Range("P3:Q" & lastrow_FinalABC) = .Range("P3:q" & lastrow_FinalABC).Value .Range("AI3:AM" & lastrow_FinalABC) = .Range("AI3:AM" & lastrow_FinalABC).Value .Range("AR3:AT" & lastrow_FinalABC) = .Range("AR3:AT" & lastrow_FinalABC).Value End With End With End Sub ' Clears formatting on the SHEETNAME1 sheet. Removes the lines between ISINs. Sub M11000_Clear_SHEETNAME1_lines() Dim lastrow_SHEETNAME1 As Long ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Clear format lines on the SHEETNAME1 sheet?", vbYesNo) = vbNo Then Exit Sub End If With Workbooks(wb_name) With .Sheets("SHEETNAME1") ' Activate the sheet. .Activate ' Get how many rows of data have been loaded into the sheet. lastrow_SHEETNAME1 = .Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_SHEETNAME1 < 3 Then lastrow_SHEETNAME1 = 3 End If ' Clear any double lines. These are used to flag where the ISIN changes. .Range("A1:BO" & lastrow_SHEETNAME1).Borders.LineStyle = xlNone End With End With End Sub ' Clears formatting on the FinalABC sheet. Removes the lines between ISINs. Sub M11110_Clear_FinalABC_lines() Dim lastrow_FinalABC As Long ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Clear format lines on the FinalABC sheet?", vbYesNo) = vbNo Then Exit Sub End If With Workbooks(wb_name) With .Sheets("FinalABC") ' Activate the sheet. .Activate ' Get how many rows of data have been loaded into the sheet. lastrow_FinalABC = .Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_FinalABC < 3 Then lastrow_FinalABC = 3 End If ' Clear any double lines. These are used to flag where the ISIN changes. .Range("A1:AT" & lastrow_FinalABC).Borders.LineStyle = xlNone End With End With End Sub ' For any row that has adjusted values different than the original value it recalculates the values against that row. ' It does this by putting formulae back in only for the specific row and then performing the recalc. ' Later the formula are replaced by values again. Sub M11200_Recalc_changed_adjusted_rows_Array() Dim lastrow_SHEETNAME1 As Long Dim lastrow_FinalABC As Long Dim recalc As Boolean Dim recalc_row As Boolean Dim FinalABC_ISIN As String Dim SHEETNAME1_ISIN As String Dim rng As Range Dim var As Variant Dim i As Long Dim J As Long Dim tmpMonth1 As String Dim tmpMonth2 As String Dim pt As PivotTable Dim column_k As Variant Dim column_y As Variant Dim column_ac As Variant Dim column_ad As Variant Dim column_ae As Variant Dim column_af As Variant Dim column_ah As Variant Dim column_ai As Variant Dim column_al As Variant Dim column_am As Variant Dim column_at As Variant Dim column_au As Variant Dim working As Variant ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Recalc changed adjusted SHEETNAME1 rows?", vbYesNo) = vbNo Then Exit Sub End If With Workbooks(wb_name) ' Get how many rows of data have been loaded into the sheet. lastrow_SHEETNAME1 = .Sheets("SHEETNAME1").Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_SHEETNAME1 < 3 Then lastrow_SHEETNAME1 = 3 End If lastrow_FinalABC = .Sheets("FinalABC").Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_FinalABC < 3 Then lastrow_FinalABC = 3 End If ' Loop through every row in SHEETNAME1 and check if any adjusted cell differs from the original. ' If so then continues with the recalc. recalc = False ReDim working(1 To lastrow_SHEETNAME1, 1) ' Working array ReDim column_k(1 To lastrow_SHEETNAME1, 1) ReDim column_y(1 To lastrow_SHEETNAME1, 1) ReDim column_ac(1 To lastrow_SHEETNAME1, 1) ReDim column_ad(1 To lastrow_SHEETNAME1, 1) ReDim column_ae(1 To lastrow_SHEETNAME1, 1) ReDim column_af(1 To lastrow_SHEETNAME1, 1) ReDim column_ah(1 To lastrow_SHEETNAME1, 1) ReDim column_ai(1 To lastrow_SHEETNAME1, 1) ReDim column_al(1 To lastrow_SHEETNAME1, 1) ReDim column_am(1 To lastrow_SHEETNAME1, 1) ReDim column_at(1 To lastrow_SHEETNAME1, 1) ReDim column_au(1 To lastrow_SHEETNAME1, 1) ' Check SHEETNAME1 for changes. With .Sheets("SHEETNAME1") ' Activate the sheet. .Activate ' Load working with dummy values - just to set its size. working = .Range("D1:D" & lastrow_SHEETNAME1) ' Load SHEETNAME1 columns into array variables. column_k = .Range("K1:K" & lastrow_SHEETNAME1) column_y = .Range("Y1:Y" & lastrow_SHEETNAME1) column_ac = .Range("AC1:AC" & lastrow_SHEETNAME1) column_ad = .Range("AD1:AD" & lastrow_SHEETNAME1) column_ae = .Range("AE1:AE" & lastrow_SHEETNAME1) column_af = .Range("AF1:AF" & lastrow_SHEETNAME1) column_ah = .Range("AH1:AH" & lastrow_SHEETNAME1) column_ai = .Range("AI1:AI" & lastrow_SHEETNAME1) column_al = .Range("AL1:AL" & lastrow_SHEETNAME1) column_am = .Range("AM1:AM" & lastrow_SHEETNAME1) column_at = .Range("AT1:AT" & lastrow_SHEETNAME1) column_au = .Range("AU1:AU" & lastrow_SHEETNAME1) For i = LBound(working) To UBound(working) ' If row 1, heading, skip If i = 1 Then GoTo NextIteration ' next i End If ' Default to false recalc_row = False ' Tax rate adjusted. If column_k(i, 1) <> "" Then recalc_row = True End If ' Include / Exclude. If column_y(i, 1) <> "INCLUDE" Then recalc_row = True End If ' Income Code Adjusted. If column_ad(i, 1) <> "" Then If column_ad(i, 1) <> column_ac(i, 1) Then recalc_row = True End If End If ' Exemption Code Adjusted. If column_af(i, 1) <> "" Then If column_af(i, 1) <> column_ae(i, 1) Then recalc_row = True End If End If ' BBH Rate Adjusted. If column_ai(i, 1) <> "" Then If column_ai(i, 1) <> column_ah(i, 1) Then recalc_row = True End If End If ' BBH CCY Adjusted. If column_am(i, 1) <> "" Then If column_am(i, 1) <> column_al(i, 1) Then recalc_row = True End If End If ' Suggested Rate Adjusted. If column_au(i, 1) <> "" Then If column_au(i, 1) <> column_at(i, 1) Then recalc_row = True End If End If ' Check if recalc_row is true. If recalc_row = True Then ' Set recalc to true recalc = True ' Convert all formula cells in the row back to formulae. .Range("A" & i & ":A" & i).Formula = .Range("A2:A2").FormulaR1C1 .Range("B" & i & ":B" & i).Formula = .Range("B2:B2").FormulaR1C1 .Range("F" & i & ":F" & i).Formula = .Range("F2:F2").FormulaR1C1 .Range("H" & i & ":H" & i).Formula = .Range("H2:H2").FormulaR1C1 .Range("J" & i & ":J" & i).Formula = .Range("J2:J2").FormulaR1C1 .Range("L" & i & ":L" & i).Formula = .Range("L2:L2").FormulaR1C1 .Range("M" & i & ":M" & i).Formula = .Range("M2:M2").FormulaR1C1 .Range("T" & i & ":T" & i).Formula = .Range("T2:T2").FormulaR1C1 .Range("V" & i & ":V" & i).Formula = .Range("V2:V2").FormulaR1C1 .Range("W" & i & ":W" & i).Formula = .Range("W2:W2").FormulaR1C1 .Range("X" & i & ":X" & i).Formula = .Range("X2:X2").FormulaR1C1 .Range("AB" & i & ":AB" & i).Formula = .Range("AB2:AB2").FormulaR1C1 .Range("AC" & i & ":AC" & i).Formula = .Range("AC2:AC2").FormulaR1C1 .Range("AE" & i & ":AE" & i).Formula = .Range("AE2:AE2").FormulaR1C1 .Range("AG" & i & ":AG" & i).Formula = .Range("AG2:AG2").FormulaR1C1 .Range("AH" & i & ":AH" & i).Formula = .Range("AH2:AH2").FormulaR1C1 .Range("AJ" & i & ":AJ" & i).Formula = .Range("AJ2:AJ2").FormulaR1C1 .Range("AK" & i & ":AK" & i).Formula = .Range("AK2:AK2").FormulaR1C1 .Range("AL" & i & ":AL" & i).Formula = .Range("AL2:AL2").FormulaR1C1 .Range("AN" & i & ":AN" & i).Formula = .Range("AN2:AN2").FormulaR1C1 .Range("AO" & i & ":AO" & i).Formula = .Range("AO2:AO2").FormulaR1C1 .Range("AP" & i & ":AP" & i).Formula = .Range("AP2:AP2").FormulaR1C1 .Range("AQ" & i & ":AQ" & i).Formula = .Range("AQ2:AQ2").FormulaR1C1 .Range("AR" & i & ":AR" & i).Formula = .Range("AR2:AR2").FormulaR1C1 .Range("AS" & i & ":AS" & i).Formula = .Range("AS2:AS2").FormulaR1C1 .Range("AT" & i & ":AT" & i).Formula = .Range("AT2:AT2").FormulaR1C1 .Range("AV" & i & ":AU" & i).Formula = .Range("AV2:AV2").FormulaR1C1 .Range("AW" & i & ":AW" & i).Formula = .Range("AW2:AW2").FormulaR1C1 .Range("AX" & i & ":AX" & i).Formula = .Range("AX2:AX2").FormulaR1C1 .Range("AY" & i & ":AY" & i).Formula = .Range("AY2:AY2").FormulaR1C1 .Range("BB" & i & ":BB" & i).Formula = .Range("BB2:BB2").FormulaR1C1 .Range("BD" & i & ":BD" & i).Formula = .Range("BD2:BD2").FormulaR1C1 .Range("BE" & i & ":BE" & i).Formula = .Range("BE2:BE2").FormulaR1C1 .Range("BG" & i & ":BG" & i).Formula = .Range("BG2:BG2").FormulaR1C1 .Range("BH" & i & ":BH" & i).Formula = .Range("BH2:BH2").FormulaR1C1 .Range("BI" & i & ":BI" & i).Formula = .Range("BI2:BI2").FormulaR1C1 .Range("BJ" & i & ":BJ" & i).Formula = .Range("BJ2:JI2").FormulaR1C1 .Range("BK" & i & ":BK" & i).Formula = .Range("BK2:BK2").FormulaR1C1 .Range("BL" & i & ":BL" & i).Formula = .Range("BL2:BL2").FormulaR1C1 ' Recalculate the entire row. .Range("A" & i & ":BO" & i).Calculate End If ' TODO - Add in here loop for all affected lines in FinalABC sheet with same ISIN. ' Then we can remove the below copy all BBH formulae down. NextIteration: Next i End With If recalc = True Then ' Refresh all impacted formula on the FinalABC sheet. With Sheets("FinalABC") ' Activate the FinalABC sheet. .Activate .Range("K2:K2").AutoFill Destination:=.Range("K2:K" & lastrow_FinalABC) .Range("L2:L2").AutoFill Destination:=.Range("L2:L" & lastrow_FinalABC) .Range("M2:M2").AutoFill Destination:=.Range("M2:M" & lastrow_FinalABC) .Range("N2:N2").AutoFill Destination:=.Range("N2:N" & lastrow_FinalABC) .Range("P2:P2").AutoFill Destination:=.Range("P2:P" & lastrow_FinalABC) .Range("Q2:Q2").AutoFill Destination:=.Range("Q2:Q" & lastrow_FinalABC) .Range("AI2:AI2").AutoFill Destination:=.Range("AI2:AI" & lastrow_FinalABC) .Range("AJ2:AJ2").AutoFill Destination:=.Range("AJ2:AJ" & lastrow_FinalABC) .Range("AK2:AK2").AutoFill Destination:=.Range("AK2:AK" & lastrow_FinalABC) .Range("AL2:AL2").AutoFill Destination:=.Range("AL2:AL" & lastrow_FinalABC) .Range("AM2:AM2").AutoFill Destination:=.Range("AM2:AM" & lastrow_FinalABC) .Range("AR2:AR2").AutoFill Destination:=.Range("AR2:AR" & lastrow_FinalABC) .Range("AS2:AS2").AutoFill Destination:=.Range("AS2:AS" & lastrow_FinalABC) .Range("AT2:AT2").AutoFill Destination:=.Range("AT2:AT" & lastrow_FinalABC) ' Recalculate the entire row. '.Range("AK2:AK" & FinalABC_lastrow).Calculate End With ' Recalculate all worksheets. Application.Calculate ' Do refresh of pivots. With Sheets("Mapping Pivots") ' Activate the Mapping Pivots sheet. .Activate ' Refresh the pivot tables. For Each pt In .PivotTables pt.RefreshTable pt.Update Next End With ' Recalculate all worksheets again to pick up Pivot values. Application.Calculate ' Now convert all impacted formulae back to values. 'TODO. loop through SHEETNAME1 as above and change formulae to values for any row impacted. ' Convert all formulae on the FinalABC sheet to values. Leaves row 2 alone. With Sheets("FinalABC") ' Activate the sheet. .Activate .Range("K3:K" & lastrow_FinalABC) = .Range("K3:K" & lastrow_FinalABC).Value .Range("L3:L" & lastrow_FinalABC) = .Range("L3:L" & lastrow_FinalABC).Value .Range("M3:M" & lastrow_FinalABC) = .Range("M3:M" & lastrow_FinalABC).Value .Range("N3:N" & lastrow_FinalABC) = .Range("N3:N" & lastrow_FinalABC).Value .Range("P3:P" & lastrow_FinalABC) = .Range("P3:P" & lastrow_FinalABC).Value .Range("Q3:Q" & lastrow_FinalABC) = .Range("Q3:Q" & lastrow_FinalABC).Value .Range("AI3:AI" & lastrow_FinalABC) = .Range("AI3:AI" & lastrow_FinalABC).Value .Range("AJ3:AJ" & lastrow_FinalABC) = .Range("AJ3:AJ" & lastrow_FinalABC).Value .Range("AK3:AK" & lastrow_FinalABC) = .Range("AK3:AK" & lastrow_FinalABC).Value .Range("AL3:AL" & lastrow_FinalABC) = .Range("AL3:AL" & lastrow_FinalABC).Value .Range("AM3:AM" & lastrow_FinalABC) = .Range("AM3:AM" & lastrow_FinalABC).Value .Range("AR3:AR" & lastrow_FinalABC) = .Range("AR3:AR" & lastrow_FinalABC).Value .Range("AS3:AS" & lastrow_FinalABC) = .Range("AS3:AS" & lastrow_FinalABC).Value .Range("AT3:AT" & lastrow_FinalABC) = .Range("AT3:AT" & lastrow_FinalABC).Value End With End If ' Convert all formulae on the SHEETNAME1 sheet to values. Leaves row 2 alone. ' Loop through every row in SHEETNAME1 and check if any adjusted cell differs from the original. ' If so then continues with the changing of the formula back to values. recalc = False ' Check SHEETNAME1 for changes. With .Sheets("SHEETNAME1") ' Activate the sheet. .Activate ' Load working with dummy values - just to set its size. working = Range("D1:D" & lastrow_SHEETNAME1) ' Load SHEETNAME1 columns into array variables. column_k = .Range("K1:K" & lastrow_SHEETNAME1) column_y = .Range("Y1:Y" & lastrow_SHEETNAME1) column_ac = .Range("AC1:AC" & lastrow_SHEETNAME1) column_ad = .Range("AD1:AD" & lastrow_SHEETNAME1) column_ae = .Range("AE1:AE" & lastrow_SHEETNAME1) column_af = .Range("AF1:AF" & lastrow_SHEETNAME1) column_ah = .Range("AH1:AH" & lastrow_SHEETNAME1) column_ai = .Range("AI1:AI" & lastrow_SHEETNAME1) column_al = .Range("AL1:AL" & lastrow_SHEETNAME1) column_am = .Range("AM1:AM" & lastrow_SHEETNAME1) column_at = .Range("AT1:AT" & lastrow_SHEETNAME1) column_au = .Range("AU1:AU" & lastrow_SHEETNAME1) For i = LBound(working) To UBound(working) ' If row 1, heading, skip If i = 1 Then GoTo NextIteration2 ' next i End If ' Default to false recalc_row = False ' Tax rate adjusted. If column_k(i, 1) <> "" Then recalc_row = True End If ' Include / Exclude. If column_y(i, 1) <> "INCLUDE" Then recalc_row = True End If ' Income Code Adjusted. If column_ad(i, 1) <> "" Then If column_ad(i, 1) <> column_ac(i, 1) Then recalc_row = True End If End If ' Exemption Code Adjusted. If column_af(i, 1) <> "" Then If column_af(i, 1) <> column_ae(i, 1) Then recalc_row = True End If End If ' BBH Rate Adjusted. If column_ai(i, 1) <> "" Then If column_ai(i, 1) <> column_ah(i, 1) Then recalc_row = True End If End If ' BBH CCY Adjusted. If column_am(i, 1) <> "" Then If column_am(i, 1) <> column_al(i, 1) Then recalc_row = True End If End If ' Suggested Rate Adjusted. If column_au(i, 1) <> "" Then If column_au(i, 1) <> column_at(i, 1) Then recalc_row = True End If End If ' Check if recalc_row is true. If recalc_row = True Then ' Set recalc to true 'recalc = True If (i > 2) Then ' leave row 2 alone, i.e. leave as formulae. .Range("A" & i & ":A" & i) = .Range("A" & i & ":A" & i).Value .Range("B" & i & ":B" & i) = .Range("B" & i & ":B" & i).Value .Range("F" & i & ":F" & i) = .Range("F" & i & ":F" & i).Value .Range("H" & i & ":H" & i) = .Range("H" & i & ":H" & i).Value .Range("J" & i & ":J" & i) = .Range("J" & i & ":J" & i).Value .Range("L" & i & ":L" & i) = .Range("L" & i & ":L" & i).Value .Range("M" & i & ":M" & i) = .Range("M" & i & ":M" & i).Value .Range("T" & i & ":T" & i) = .Range("T" & i & ":T" & i).Value .Range("V" & i & ":V" & i) = .Range("V" & i & ":V" & i).Value .Range("W" & i & ":W" & i) = .Range("W" & i & ":W" & i).Value .Range("X" & i & ":X" & i) = .Range("X" & i & ":X" & i).Value .Range("AB" & i & ":AB" & i) = .Range("AB" & i & ":AB" & i).Value .Range("AC" & i & ":AC" & i) = .Range("AC" & i & ":AC" & i).Value .Range("AE" & i & ":AE" & i) = .Range("AE" & i & ":AE" & i).Value .Range("AG" & i & ":AG" & i) = .Range("AG" & i & ":AG" & i).Value .Range("AH" & i & ":AH" & i) = .Range("AH" & i & ":AH" & i).Value .Range("AJ" & i & ":AJ" & i) = .Range("AJ" & i & ":AJ" & i).Value .Range("AK" & i & ":AK" & i) = .Range("AK" & i & ":AK" & i).Value .Range("AL" & i & ":AL" & i) = .Range("AL" & i & ":AL" & i).Value .Range("AN" & i & ":AN" & i) = .Range("AN" & i & ":AN" & i).Value .Range("AO" & i & ":AO" & i) = .Range("AO" & i & ":AO" & i).Value .Range("AP" & i & ":AP" & i) = .Range("AP" & i & ":AP" & i).Value .Range("AQ" & i & ":AQ" & i) = .Range("AQ" & i & ":AQ" & i).Value .Range("AR" & i & ":AR" & i) = .Range("AR" & i & ":AR" & i).Value .Range("AS" & i & ":AS" & i) = .Range("AS" & i & ":AS" & i).Value .Range("AT" & i & ":AT" & i) = .Range("AT" & i & ":AT" & i).Value .Range("AV" & i & ":AV" & i) = .Range("AV" & i & ":AV" & i).Value .Range("AW" & i & ":AW" & i) = .Range("AW" & i & ":AW" & i).Value .Range("AX" & i & ":AX" & i) = .Range("AX" & i & ":AX" & i).Value .Range("AY" & i & ":AY" & i) = .Range("AY" & i & ":AY" & i).Value .Range("BB" & i & ":BB" & i) = .Range("BB" & i & ":BB" & i).Value .Range("BD" & i & ":BD" & i) = .Range("BD" & i & ":BD" & i).Value .Range("BE" & i & ":BE" & i) = .Range("BE" & i & ":BE" & i).Value .Range("BG" & i & ":BG" & i) = .Range("BG" & i & ":BG" & i).Value .Range("BH" & i & ":BH" & i) = .Range("BH" & i & ":BH" & i).Value .Range("BI" & i & ":BI" & i) = .Range("BI" & i & ":BI" & i).Value .Range("BJ" & i & ":BJ" & i) = .Range("BJ" & i & ":BJ" & i).Value .Range("BK" & i & ":BK" & i) = .Range("BK" & i & ":BK" & i).Value .Range("BL" & i & ":BL" & i) = .Range("BL" & i & ":BL" & i).Value End If End If NextIteration2: Next i End With '********************************************************************************************* ' Check FinalABC for adjustment changes. ' Loop through every row in SHEETNAME1 and check if any adjusted cell differs from the original. ' If so then continues with the recalc. For i = 2 To lastrow_FinalABC ' Default to false recalc_row = False recalc = False ' Check FinalABC for changes. With .Sheets("FinalABC") ' Activate the sheet. .Activate ' USD Adjustments. If .Range("J" & i).Value <> "" Then recalc_row = True End If ' Tax Rate Adjusted If .Range("R" & i).Value <> "" Then recalc_row = True End If ' Adjusted date. tmpMonth1 = UCase(Left(.Range("F" & i).Value, 3)) tmpMonth2 = UCase(Left(Right(.Range("A" & i).Value, 8), 3)) If (tmpMonth1 <> tmpMonth2) Then recalc_row = True End If ' Check if recalc_row is true. If recalc_row = True Then ' Set recalc to true recalc = True ' Convert all formula cells in the row back to formulae. .Range("K" & i & ":K" & i).Formula = .Range("K2:K2").FormulaR1C1 .Range("L" & i & ":L" & i).Formula = .Range("L2:L2").FormulaR1C1 .Range("M" & i & ":M" & i).Formula = .Range("M2:M2").FormulaR1C1 .Range("N" & i & ":N" & i).Formula = .Range("N2:N2").FormulaR1C1 .Range("P" & i & ":P" & i).Formula = .Range("P2:P2").FormulaR1C1 .Range("Q" & i & ":Q" & i).Formula = .Range("Q2:Q2").FormulaR1C1 .Range("AI" & i & ":AI" & i).Formula = .Range("AI2:AI2").FormulaR1C1 .Range("AJ" & i & ":AJ" & i).Formula = .Range("AJ2:AJ2").FormulaR1C1 .Range("AK" & i & ":AK" & i).Formula = .Range("AK2:AK2").FormulaR1C1 .Range("AL" & i & ":AL" & i).Formula = .Range("AL2:AL2").FormulaR1C1 .Range("AM" & i & ":AM" & i).Formula = .Range("AM2:AM2").FormulaR1C1 .Range("AR" & i & ":AR" & i).Formula = .Range("AR2:AR2").FormulaR1C1 .Range("AS" & i & ":AS" & i).Formula = .Range("AS2:AS2").FormulaR1C1 .Range("AT" & i & ":AT" & i).Formula = .Range("AT2:AT2").FormulaR1C1 ' Recalculate the entire row. .Range("A" & i & ":AR" & i).Calculate ' Get starting position of the affected ISIN within the SHEETNAME1 sheet. FinalABC_ISIN = .Range("A" & i).Value End If End With If recalc = True Then ' Do refresh of Mapping pivots With .Sheets("Mapping Pivots") ' Activate the sheet. .Activate ' Refresh the pivots. For Each pt In .PivotTables pt.RefreshTable pt.Update Next End With ' Now get index of first row in SHEETNAME1 sheet that contains same affected ISIN. With .Sheets("SHEETNAME1") Set rng = .Range("A1:A" & lastrow_SHEETNAME1) If WorksheetFunction.CountIf(rng, FinalABC_ISIN) > 0 Then var = WorksheetFunction.Match(FinalABC_ISIN, rng, 0) If Not IsError(var) Then J = var SHEETNAME1_ISIN = .Range("A" & J).Value ' For every row that has same ISIN re-enable formulae in SHEETNAME1 sheet. ' Convert all formula cells in the row back to formulae. While .Range("A" & J).Value = SHEETNAME1_ISIN .Range("A" & J & ":A" & J).Formula = .Range("A2:A2").FormulaR1C1 .Range("B" & J & ":B" & J).Formula = .Range("B2:B2").FormulaR1C1 .Range("F" & J & ":F" & J).Formula = .Range("F2:F2").FormulaR1C1 .Range("H" & J & ":H" & J).Formula = .Range("H2:H2").FormulaR1C1 .Range("J" & J & ":J" & J).Formula = .Range("J2:J2").FormulaR1C1 .Range("L" & J & ":L" & J).Formula = .Range("L2:L2").FormulaR1C1 .Range("M" & J & ":M" & J).Formula = .Range("M2:M2").FormulaR1C1 .Range("T" & J & ":T" & J).Formula = .Range("T2:T2").FormulaR1C1 .Range("V" & J & ":V" & J).Formula = .Range("V2:V2").FormulaR1C1 .Range("W" & J & ":W" & J).Formula = .Range("W2:W2").FormulaR1C1 .Range("X" & J & ":X" & J).Formula = .Range("X2:X2").FormulaR1C1 .Range("AB" & J & ":AB" & J).Formula = .Range("AB2:AB2").FormulaR1C1 .Range("AC" & J & ":AD" & J).Formula = .Range("AC2:AC2").FormulaR1C1 .Range("AE" & J & ":AE" & J).Formula = .Range("AE2:AE2").FormulaR1C1 .Range("AG" & J & ":AG" & J).Formula = .Range("AG2:AG2").FormulaR1C1 .Range("AH" & J & ":AH" & J).Formula = .Range("AH2:AH2").FormulaR1C1 .Range("AJ" & J & ":AJ" & J).Formula = .Range("AJ2:AJ2").FormulaR1C1 .Range("AK" & J & ":AK" & J).Formula = .Range("AK2:AK2").FormulaR1C1 .Range("AL" & J & ":AL" & J).Formula = .Range("AL2:AL2").FormulaR1C1 .Range("AN" & J & ":AN" & J).Formula = .Range("AN2:AN2").FormulaR1C1 .Range("AO" & J & ":AO" & J).Formula = .Range("AO2:AO2").FormulaR1C1 .Range("AP" & J & ":AP" & J).Formula = .Range("AP2:AP2").FormulaR1C1 .Range("AQ" & J & ":AQ" & J).Formula = .Range("AQ2:AQ2").FormulaR1C1 .Range("AR" & J & ":AR" & J).Formula = .Range("AR2:AR2").FormulaR1C1 .Range("AS" & J & ":AS" & J).Formula = .Range("AS2:AS2").FormulaR1C1 .Range("AT" & J & ":AT" & J).Formula = .Range("AT2:AT2").FormulaR1C1 .Range("AV" & J & ":AV" & J).Formula = .Range("AV2:AV2").FormulaR1C1 .Range("AW" & J & ":AW" & J).Formula = .Range("AW2:AW2").FormulaR1C1 .Range("AX" & J & ":AX" & J).Formula = .Range("AX2:AX2").FormulaR1C1 .Range("AY" & J & ":AY" & J).Formula = .Range("AY2:AY2").FormulaR1C1 .Range("BB" & J & ":BB" & J).Formula = .Range("BB2:BB2").FormulaR1C1 .Range("BD" & J & ":BD" & J).Formula = .Range("BD2:BD2").FormulaR1C1 .Range("BE" & J & ":BE" & J).Formula = .Range("BE2:BE2").FormulaR1C1 .Range("BG" & J & ":BG" & J).Formula = .Range("BG2:BG2").FormulaR1C1 .Range("BH" & J & ":BH" & J).Formula = .Range("BH2:BH2").FormulaR1C1 .Range("BI" & J & ":BI" & J).Formula = .Range("BI2:BI2").FormulaR1C1 .Range("BJ" & J & ":BJ" & J).Formula = .Range("BJ2:BJ2").FormulaR1C1 .Range("BK" & J & ":BK" & J).Formula = .Range("BK2:BK2").FormulaR1C1 .Range("BL" & J & ":BL" & J).Formula = .Range("BL2:BL2").FormulaR1C1 ' Recalculate the entire row. .Range("A" & J & ":BO" & J).Calculate ' next row J = J + 1 Wend Else Message "The ISIN " & FinalABC_ISIN & " cannot be found in the SHEETNAME1 sheet." End If End If End With ' Recalculate all worksheets. Application.Calculate ' Now convert all impacted formulae back to values. 'TODO. loop through SHEETNAME1 as above and change formulae to values for any row impacted. ' Convert all formulae on the FinalABC sheet to values. Leaves row 2 alone. If (i > 2) Then ' leave row 2 alone, i.e. leave as formulae. With .Sheets("FinalABC") ' Activate the sheet. .Activate .Range("K" & i & ":K" & i) = .Range("K" & i & ":K" & i).Value .Range("L" & i & ":L" & i) = .Range("L" & i & ":L" & i).Value .Range("M" & i & ":M" & i) = .Range("M" & i & ":M" & i).Value .Range("N" & i & ":N" & i) = .Range("N" & i & ":N" & i).Value .Range("P" & i & ":P" & i) = .Range("P" & i & ":P" & i).Value .Range("Q" & i & ":Q" & i) = .Range("Q" & i & ":Q" & i).Value .Range("AI" & i & ":AI" & i) = .Range("AI" & i & ":AI" & i).Value .Range("AJ" & i & ":AJ" & i) = .Range("AJ" & i & ":AJ" & i).Value .Range("AK" & i & ":AK" & i) = .Range("AK" & i & ":AK" & i).Value .Range("AL" & i & ":AL" & i) = .Range("AL" & i & ":AL" & i).Value .Range("AM" & i & ":AM" & i) = .Range("AM" & i & ":AM" & i).Value .Range("AR" & i & ":AR" & i) = .Range("AR" & i & ":AR" & i).Value .Range("AS" & i & ":AS" & i) = .Range("AS" & i & ":AS" & i).Value .Range("AT" & i & ":AT" & i) = .Range("AT" & i & ":AT" & i).Value End With End If ' Convert all formulae on the SHEETNAME1 sheet to values. Leaves row 2 alone. With .Sheets("SHEETNAME1") ' Activate the sheet. .Activate ' Now get index of first row in SHEETNAME1 sheet that contains same affected ISIN. Set rng = .Range("A1:A" & lastrow_SHEETNAME1) If WorksheetFunction.CountIf(rng, FinalABC_ISIN) > 0 Then var = WorksheetFunction.Match(FinalABC_ISIN, rng, 0) If Not IsError(var) Then J = var SHEETNAME1_ISIN = .Range("A" & J).Value ' For every row that has same ISIN re-enable formulae in SHEETNAME1 sheet. ' Convert all formula cells in the row back to values. While .Range("A" & J).Value = SHEETNAME1_ISIN If (J > 2) Then ' leave row 2 alone, i.e. leave as formulae. .Range("A" & J & ":A" & J) = .Range("A" & J & ":A" & J).Value .Range("B" & J & ":B" & J) = .Range("B" & J & ":B" & J).Value .Range("F" & J & ":F" & J) = .Range("F" & J & ":F" & J).Value .Range("H" & J & ":H" & J) = .Range("H" & J & ":H" & J).Value .Range("J" & J & ":J" & J) = .Range("J" & J & ":J" & J).Value .Range("L" & J & ":L" & J) = .Range("L" & J & ":L" & J).Value .Range("M" & J & ":M" & J) = .Range("M" & J & ":M" & J).Value .Range("T" & J & ":T" & J) = .Range("T" & J & ":T" & J).Value .Range("V" & J & ":V" & J) = .Range("V" & J & ":V" & J).Value .Range("W" & J & ":W" & J) = .Range("W" & J & ":W" & J).Value .Range("X" & J & ":X" & J) = .Range("X" & J & ":X" & J).Value .Range("AB" & J & ":AB" & J) = .Range("AB" & J & ":AB" & J).Value .Range("AC" & J & ":AC" & J) = .Range("AC" & J & ":AC" & J).Value .Range("AE" & J & ":AE" & J) = .Range("AE" & J & ":AE" & J).Value .Range("AG" & J & ":AG" & J) = .Range("AG" & J & ":AG" & J).Value .Range("AH" & J & ":AH" & J) = .Range("AH" & J & ":AH" & J).Value .Range("AJ" & J & ":AJ" & J) = .Range("AJ" & J & ":AJ" & J).Value .Range("AK" & J & ":AK" & J) = .Range("AK" & J & ":AK" & J).Value .Range("AL" & J & ":AL" & J) = .Range("AL" & J & ":AL" & J).Value .Range("AN" & J & ":AN" & J) = .Range("AN" & J & ":AN" & J).Value .Range("AO" & J & ":AO" & J) = .Range("AO" & J & ":AO" & J).Value .Range("AP" & J & ":AP" & J) = .Range("AP" & J & ":AP" & J).Value .Range("AQ" & J & ":AQ" & J) = .Range("AQ" & J & ":AQ" & J).Value .Range("AR" & J & ":AR" & J) = .Range("AR" & J & ":AR" & J).Value .Range("AS" & J & ":AS" & J) = .Range("AS" & J & ":AS" & J).Value .Range("AT" & J & ":AT" & J) = .Range("AT" & J & ":AT" & J).Value .Range("AV" & J & ":AV" & J) = .Range("AV" & J & ":AV" & J).Value .Range("AW" & J & ":AW" & J) = .Range("AW" & J & ":AW" & J).Value .Range("AX" & J & ":AX" & J) = .Range("AX" & J & ":AX" & J).Value .Range("AY" & J & ":AY" & J) = .Range("AY" & J & ":AY" & J).Value .Range("BB" & J & ":BB" & J) = .Range("BB" & J & ":BB" & J).Value .Range("BD" & J & ":BD" & J) = .Range("BD" & J & ":BD" & J).Value .Range("BE" & J & ":BE" & J) = .Range("BE" & J & ":BE" & J).Value .Range("BG" & J & ":BG" & J) = .Range("BG" & J & ":BG" & J).Value .Range("BH" & J & ":BH" & J) = .Range("BH" & J & ":BH" & J).Value .Range("BI" & J & ":BI" & J) = .Range("BI" & J & ":BI" & J).Value .Range("BJ" & J & ":BJ" & J) = .Range("BJ" & J & ":BJ" & J).Value .Range("BK" & J & ":BK" & J) = .Range("BK" & J & ":BK" & J).Value .Range("BL" & J & ":BL" & J) = .Range("BL" & J & ":BL" & J).Value End If ' next row J = J + 1 Wend Else Message "The ISIN " & FinalABC_ISIN & " cannot be found in the SHEETNAME1 sheet." End If End If End With End If Next i End With ' Clear all objects. Set pt = Nothing Set rng = Nothing Set var = Nothing Set working = Nothing Set column_k = Nothing Set column_y = Nothing Set column_ac = Nothing Set column_ad = Nothing Set column_ae = Nothing Set column_af = Nothing Set column_ah = Nothing Set column_ai = Nothing Set column_al = Nothing Set column_am = Nothing Set column_at = Nothing Set column_au = Nothing End Sub ' For any row that has adjusted values different than the original value it recalculates the values against that row. ' It does this by putting formulae back in only for the specific row and then performing the recalc. ' Later the formula are replaced by values again. Sub M11205_Recalc_changed_adjusted_rows_Array_NEW() Dim lastrow_SHEETNAME1 As Long Dim lastrow_FinalABC As Long Dim recalc As Boolean Dim recalc_row As Boolean Dim FinalABC_ISIN As String Dim SHEETNAME1_ISIN As String Dim rng As Range Dim var As Variant Dim i As Long Dim J As Long Dim tmpMonth1 As String Dim tmpMonth2 As String Dim pt As PivotTable Dim column_k As Variant Dim column_y As Variant Dim column_ac As Variant Dim column_ad As Variant Dim column_ae As Variant Dim column_af As Variant Dim column_ah As Variant Dim column_ai As Variant Dim column_al As Variant Dim column_am As Variant Dim column_at As Variant Dim column_au As Variant Dim working As Variant ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Recalc changed adjusted SHEETNAME1 rows?", vbYesNo) = vbNo Then Exit Sub End If With Workbooks(wb_name) ' Get how many rows of data have been loaded into the sheet. lastrow_SHEETNAME1 = .Sheets("SHEETNAME1").Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_SHEETNAME1 < 3 Then lastrow_SHEETNAME1 = 3 End If lastrow_FinalABC = .Sheets("FinalABC").Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_FinalABC < 3 Then lastrow_FinalABC = 3 End If ' Loop through every row in SHEETNAME1 and check if any adjusted cell differs from the original. ' If so then continues with the recalc. recalc = False ReDim working(1 To lastrow_SHEETNAME1, 1) ' Working array ReDim column_k(1 To lastrow_SHEETNAME1, 1) ReDim column_y(1 To lastrow_SHEETNAME1, 1) ReDim column_ac(1 To lastrow_SHEETNAME1, 1) ReDim column_ad(1 To lastrow_SHEETNAME1, 1) ReDim column_ae(1 To lastrow_SHEETNAME1, 1) ReDim column_af(1 To lastrow_SHEETNAME1, 1) ReDim column_ah(1 To lastrow_SHEETNAME1, 1) ReDim column_ai(1 To lastrow_SHEETNAME1, 1) ReDim column_al(1 To lastrow_SHEETNAME1, 1) ReDim column_am(1 To lastrow_SHEETNAME1, 1) ReDim column_at(1 To lastrow_SHEETNAME1, 1) ReDim column_au(1 To lastrow_SHEETNAME1, 1) ' Check SHEETNAME1 for changes. With .Sheets("SHEETNAME1") ' Activate the sheet. .Activate ' Load working with dummy values - just to set its size. working = .Range("D1:D" & lastrow_SHEETNAME1) ' Load SHEETNAME1 columns into array variables. column_k = .Range("K1:K" & lastrow_SHEETNAME1) column_y = .Range("Y1:Y" & lastrow_SHEETNAME1) column_ac = .Range("AC1:AC" & lastrow_SHEETNAME1) column_ad = .Range("AD1:AD" & lastrow_SHEETNAME1) column_ae = .Range("AE1:AE" & lastrow_SHEETNAME1) column_af = .Range("AF1:AF" & lastrow_SHEETNAME1) column_ah = .Range("AH1:AH" & lastrow_SHEETNAME1) column_ai = .Range("AI1:AI" & lastrow_SHEETNAME1) column_al = .Range("AL1:AL" & lastrow_SHEETNAME1) column_am = .Range("AM1:AM" & lastrow_SHEETNAME1) column_at = .Range("AT1:AT" & lastrow_SHEETNAME1) column_au = .Range("AU1:AU" & lastrow_SHEETNAME1) For i = LBound(working) To UBound(working) ' If row 1, heading, skip If i = 1 Then GoTo NextIteration ' next i End If ' Default to false recalc_row = False ' Tax rate adjusted. If column_k(i, 1) <> "" Then recalc_row = True End If ' Include / Exclude. If column_y(i, 1) <> "INCLUDE" Then recalc_row = True End If ' Income Code Adjusted. If column_ad(i, 1) <> "" Then If column_ad(i, 1) <> column_ac(i, 1) Then recalc_row = True End If End If ' Exemption Code Adjusted. If column_af(i, 1) <> "" Then If column_af(i, 1) <> column_ae(i, 1) Then recalc_row = True End If End If ' BBH Rate Adjusted. If column_ai(i, 1) <> "" Then If column_ai(i, 1) <> column_ah(i, 1) Then recalc_row = True End If End If ' BBH CCY Adjusted. If column_am(i, 1) <> "" Then If column_am(i, 1) <> column_al(i, 1) Then recalc_row = True End If End If ' Suggested Rate Adjusted. If column_au(i, 1) <> "" Then If column_au(i, 1) <> column_at(i, 1) Then recalc_row = True End If End If ' Check if recalc_row is true. If recalc_row = True Then ' Set recalc to true recalc = True ' Get starting position of the affected ISIN within the SHEETNAME1 sheet. SHEETNAME1_ISIN = .Range("A" & i).Value ' Convert all formula cells in the row back to formulae. .Range("A" & i & ":A" & i).Formula = .Range("A2:A2").FormulaR1C1 .Range("B" & i & ":B" & i).Formula = .Range("B2:B2").FormulaR1C1 .Range("F" & i & ":F" & i).Formula = .Range("F2:F2").FormulaR1C1 .Range("H" & i & ":H" & i).Formula = .Range("H2:H2").FormulaR1C1 .Range("J" & i & ":J" & i).Formula = .Range("J2:J2").FormulaR1C1 .Range("L" & i & ":L" & i).Formula = .Range("L2:L2").FormulaR1C1 .Range("M" & i & ":M" & i).Formula = .Range("M2:M2").FormulaR1C1 .Range("T" & i & ":T" & i).Formula = .Range("T2:T2").FormulaR1C1 .Range("V" & i & ":V" & i).Formula = .Range("V2:V2").FormulaR1C1 .Range("W" & i & ":W" & i).Formula = .Range("W2:W2").FormulaR1C1 .Range("X" & i & ":X" & i).Formula = .Range("X2:X2").FormulaR1C1 .Range("AB" & i & ":AB" & i).Formula = .Range("AB2:AB2").FormulaR1C1 .Range("AC" & i & ":AC" & i).Formula = .Range("AC2:AC2").FormulaR1C1 .Range("AE" & i & ":AE" & i).Formula = .Range("AE2:AE2").FormulaR1C1 .Range("AG" & i & ":AG" & i).Formula = .Range("AG2:AG2").FormulaR1C1 .Range("AH" & i & ":AH" & i).Formula = .Range("AH2:AH2").FormulaR1C1 .Range("AJ" & i & ":AJ" & i).Formula = .Range("AJ2:AJ2").FormulaR1C1 .Range("AK" & i & ":AK" & i).Formula = .Range("AK2:AK2").FormulaR1C1 .Range("AL" & i & ":AL" & i).Formula = .Range("AL2:AL2").FormulaR1C1 .Range("AN" & i & ":AN" & i).Formula = .Range("AN2:AN2").FormulaR1C1 .Range("AO" & i & ":AO" & i).Formula = .Range("AO2:AO2").FormulaR1C1 .Range("AP" & i & ":AP" & i).Formula = .Range("AP2:AP2").FormulaR1C1 .Range("AQ" & i & ":AQ" & i).Formula = .Range("AQ2:AQ2").FormulaR1C1 .Range("AR" & i & ":AR" & i).Formula = .Range("AR2:AR2").FormulaR1C1 .Range("AS" & i & ":AS" & i).Formula = .Range("AS2:AS2").FormulaR1C1 .Range("AT" & i & ":AT" & i).Formula = .Range("AT2:AT2").FormulaR1C1 .Range("AV" & i & ":AU" & i).Formula = .Range("AV2:AV2").FormulaR1C1 .Range("AW" & i & ":AW" & i).Formula = .Range("AW2:AW2").FormulaR1C1 .Range("AX" & i & ":AX" & i).Formula = .Range("AX2:AX2").FormulaR1C1 .Range("AY" & i & ":AY" & i).Formula = .Range("AY2:AY2").FormulaR1C1 .Range("BB" & i & ":BB" & i).Formula = .Range("BB2:BB2").FormulaR1C1 .Range("BD" & i & ":BD" & i).Formula = .Range("BD2:BD2").FormulaR1C1 .Range("BE" & i & ":BE" & i).Formula = .Range("BE2:BE2").FormulaR1C1 .Range("BG" & i & ":BG" & i).Formula = .Range("BG2:BG2").FormulaR1C1 .Range("BH" & i & ":BH" & i).Formula = .Range("BH2:BH2").FormulaR1C1 .Range("BI" & i & ":BI" & i).Formula = .Range("BI2:BI2").FormulaR1C1 .Range("BJ" & i & ":BJ" & i).Formula = .Range("BJ2:JI2").FormulaR1C1 .Range("BK" & i & ":BK" & i).Formula = .Range("BK2:BK2").FormulaR1C1 .Range("BL" & i & ":BL" & i).Formula = .Range("BL2:BL2").FormulaR1C1 ' Recalculate the entire row. .Range("A" & i & ":BO" & i).Calculate '-------------------------------------------------------------------------- ' TODO - Add in here loop for all affected lines in FinalABC sheet with same ISIN. ' Then we can remove the below copy all BBH formulae down. ' Now get index of first row in FinalABC sheet that contains same affected ISIN. With Sheets("FinalABC") Set rng = .Range("A1:A" & lastrow_FinalABC) If WorksheetFunction.CountIf(rng, SHEETNAME1_ISIN) > 0 Then var = WorksheetFunction.Match(SHEETNAME1_ISIN, rng, 0) If Not IsError(var) Then J = var FinalABC_ISIN = .Range("A" & J).Value ' For every row that has same ISIN re-enable formulae in SHEETNAME1 sheet. ' Convert all formula cells in the row back to formulae. While .Range("A" & J).Value = FinalABC_ISIN ' Convert all formula cells in the row back to formulae. .Range("K" & J & ":K" & J).Formula = .Range("K2:K2").FormulaR1C1 .Range("L" & J & ":L" & J).Formula = .Range("L2:L2").FormulaR1C1 .Range("M" & J & ":M" & J).Formula = .Range("M2:M2").FormulaR1C1 .Range("N" & J & ":N" & J).Formula = .Range("N2:N2").FormulaR1C1 .Range("P" & J & ":P" & J).Formula = .Range("P2:P2").FormulaR1C1 .Range("Q" & J & ":Q" & J).Formula = .Range("Q2:Q2").FormulaR1C1 .Range("AI" & J & ":AI" & J).Formula = .Range("AI2:AI2").FormulaR1C1 .Range("AJ" & J & ":AJ" & J).Formula = .Range("AJ2:AJ2").FormulaR1C1 .Range("AK" & J & ":AK" & J).Formula = .Range("AK2:AK2").FormulaR1C1 .Range("AL" & J & ":AL" & J).Formula = .Range("AL2:AL2").FormulaR1C1 .Range("AM" & J & ":AM" & J).Formula = .Range("AM2:AM2").FormulaR1C1 .Range("AR" & J & ":AR" & J).Formula = .Range("AR2:AR2").FormulaR1C1 .Range("AS" & J & ":AS" & J).Formula = .Range("AS2:AS2").FormulaR1C1 .Range("AT" & J & ":AT" & J).Formula = .Range("AT2:AT2").FormulaR1C1 ' Recalculate the entire row. .Range("A" & J & ":AT" & J).Calculate ' Convert all formulae on the FinalABC sheet to values. Leaves row 2 alone. If (J > 2) Then .Range("K" & J & ":K" & J) = .Range("K" & J & ":K" & J).Value .Range("L" & J & ":L" & J) = .Range("L" & J & ":L" & J).Value .Range("M" & J & ":M" & J) = .Range("M" & J & ":M" & J).Value .Range("N" & J & ":N" & J) = .Range("N" & J & ":N" & J).Value .Range("P" & J & ":P" & J) = .Range("P" & J & ":P" & J).Value .Range("Q" & J & ":Q" & J) = .Range("Q" & J & ":Q" & J).Value .Range("AI" & J & ":AI" & J) = .Range("AI" & J & ":AI" & J).Value .Range("AJ" & J & ":AJ" & J) = .Range("AJ" & J & ":AJ" & J).Value .Range("AK" & J & ":AK" & J) = .Range("AK" & J & ":AK" & J).Value .Range("AL" & J & ":AL" & J) = .Range("AL" & J & ":AL" & J).Value .Range("AM" & J & ":AM" & J) = .Range("AM" & J & ":AM" & J).Value .Range("AR" & J & ":AR" & J) = .Range("AR" & J & ":AR" & J).Value .Range("AS" & J & ":AS" & J) = .Range("AS" & J & ":AS" & J).Value .Range("AT" & J & ":AT" & J) = .Range("AT" & J & ":AT" & J).Value End If ' next row J = J + 1 Wend Else Message "The ISIN " & SHEETNAME1_ISIN & " cannot be found in the FinalABC sheet." End If End If End With ' Convert all formulae on the SHEETNAME1 sheet to values. Leaves row 2 alone. If (i > 2) Then .Range("A" & i & ":A" & i) = .Range("A" & i & ":A" & i).Value .Range("B" & i & ":B" & i) = .Range("B" & i & ":B" & i).Value .Range("F" & i & ":F" & i) = .Range("F" & i & ":F" & i).Value .Range("H" & i & ":H" & i) = .Range("H" & i & ":H" & i).Value .Range("J" & i & ":J" & i) = .Range("J" & i & ":J" & i).Value .Range("L" & i & ":L" & i) = .Range("L" & i & ":L" & i).Value .Range("M" & i & ":M" & i) = .Range("M" & i & ":M" & i).Value .Range("T" & i & ":T" & i) = .Range("T" & i & ":T" & i).Value .Range("V" & i & ":V" & i) = .Range("V" & i & ":V" & i).Value .Range("W" & i & ":W" & i) = .Range("W" & i & ":W" & i).Value .Range("X" & i & ":X" & i) = .Range("X" & i & ":X" & i).Value .Range("AB" & i & ":AB" & i) = .Range("AB" & i & ":AB" & i).Value .Range("AC" & i & ":AC" & i) = .Range("AC" & i & ":AC" & i).Value .Range("AE" & i & ":AE" & i) = .Range("AE" & i & ":AE" & i).Value .Range("AG" & i & ":AG" & i) = .Range("AG" & i & ":AG" & i).Value .Range("AH" & i & ":AH" & i) = .Range("AH" & i & ":AH" & i).Value .Range("AJ" & i & ":AJ" & i) = .Range("AJ" & i & ":AJ" & i).Value .Range("AK" & i & ":AK" & i) = .Range("AK" & i & ":AK" & i).Value .Range("AL" & i & ":AL" & i) = .Range("AL" & i & ":AL" & i).Value .Range("AN" & i & ":AN" & i) = .Range("AN" & i & ":AN" & i).Value .Range("AO" & i & ":AO" & i) = .Range("AO" & i & ":AO" & i).Value .Range("AP" & i & ":AP" & i) = .Range("AP" & i & ":AP" & i).Value .Range("AQ" & i & ":AQ" & i) = .Range("AQ" & i & ":AQ" & i).Value .Range("AR" & i & ":AR" & i) = .Range("AR" & i & ":AR" & i).Value .Range("AS" & i & ":AS" & i) = .Range("AS" & i & ":AS" & i).Value .Range("AT" & i & ":AT" & i) = .Range("AT" & i & ":AT" & i).Value .Range("AV" & i & ":AV" & i) = .Range("AV" & i & ":AV" & i).Value .Range("AW" & i & ":AW" & i) = .Range("AW" & i & ":AW" & i).Value .Range("AX" & i & ":AX" & i) = .Range("AX" & i & ":AX" & i).Value .Range("AY" & i & ":AY" & i) = .Range("AY" & i & ":AY" & i).Value .Range("BB" & i & ":BB" & i) = .Range("BB" & i & ":BB" & i).Value .Range("BD" & i & ":BD" & i) = .Range("BD" & i & ":BD" & i).Value .Range("BE" & i & ":BE" & i) = .Range("BE" & i & ":BE" & i).Value .Range("BG" & i & ":BG" & i) = .Range("BG" & i & ":BG" & i).Value .Range("BH" & i & ":BH" & i) = .Range("BH" & i & ":BH" & i).Value .Range("BI" & i & ":BI" & i) = .Range("BI" & i & ":BI" & i).Value .Range("BJ" & i & ":BJ" & i) = .Range("BJ" & i & ":BJ" & i).Value .Range("BK" & i & ":BK" & i) = .Range("BK" & i & ":BK" & i).Value .Range("BL" & i & ":BL" & i) = .Range("BL" & i & ":BL" & i).Value End If '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ End If NextIteration: Next i End With If recalc = True Then ' Do refresh of pivots. With Sheets("Mapping Pivots") ' Activate the Mapping Pivots sheet. .Activate ' Refresh the pivot tables. For Each pt In .PivotTables pt.RefreshTable pt.Update Next End With End If '********************************************************************************************* ' Check FinalABC for adjustment changes. ' Loop through every row in SHEETNAME1 and check if any adjusted cell differs from the original. ' If so then continues with the recalc. For i = 2 To lastrow_FinalABC ' Default to false recalc_row = False recalc = False ' Check FinalABC for changes. With .Sheets("FinalABC") ' Activate the sheet. .Activate ' USD Adjustments. If .Range("J" & i).Value <> "" Then recalc_row = True End If ' Tax Rate Adjusted If .Range("R" & i).Value <> "" Then recalc_row = True End If ' Adjusted date. tmpMonth1 = UCase(Left(.Range("F" & i).Value, 3)) tmpMonth2 = UCase(Left(Right(.Range("A" & i).Value, 8), 3)) If (tmpMonth1 <> tmpMonth2) Then recalc_row = True End If ' Check if recalc_row is true. If recalc_row = True Then ' Set recalc to true recalc = True ' Convert all formula cells in the row back to formulae. .Range("K" & i & ":K" & i).Formula = .Range("K2:K2").FormulaR1C1 .Range("L" & i & ":L" & i).Formula = .Range("L2:L2").FormulaR1C1 .Range("M" & i & ":M" & i).Formula = .Range("M2:M2").FormulaR1C1 .Range("N" & i & ":N" & i).Formula = .Range("N2:N2").FormulaR1C1 .Range("P" & i & ":P" & i).Formula = .Range("P2:P2").FormulaR1C1 .Range("Q" & i & ":Q" & i).Formula = .Range("Q2:Q2").FormulaR1C1 .Range("AI" & i & ":AI" & i).Formula = .Range("AI2:AI2").FormulaR1C1 .Range("AJ" & i & ":AJ" & i).Formula = .Range("AJ2:AJ2").FormulaR1C1 .Range("AK" & i & ":AK" & i).Formula = .Range("AK2:AK2").FormulaR1C1 .Range("AL" & i & ":AL" & i).Formula = .Range("AL2:AL2").FormulaR1C1 .Range("AM" & i & ":AM" & i).Formula = .Range("AM2:AM2").FormulaR1C1 .Range("AR" & i & ":AR" & i).Formula = .Range("AR2:AR2").FormulaR1C1 .Range("AS" & i & ":AS" & i).Formula = .Range("AS2:AS2").FormulaR1C1 .Range("AT" & i & ":AT" & i).Formula = .Range("AT2:AT2").FormulaR1C1 ' Recalculate the entire row. .Range("A" & i & ":AT" & i).Calculate ' Get starting position of the affected ISIN within the SHEETNAME1 sheet. FinalABC_ISIN = .Range("A" & i).Value End If End With If recalc = True Then ' Do refresh of Mapping pivots With .Sheets("Mapping Pivots") ' Activate the sheet. .Activate ' Refresh the pivots. For Each pt In .PivotTables pt.RefreshTable pt.Update Next End With ' Now get index of first row in SHEETNAME1 sheet that contains same affected ISIN. With .Sheets("SHEETNAME1") Set rng = .Range("A1:A" & lastrow_SHEETNAME1) If WorksheetFunction.CountIf(rng, FinalABC_ISIN) > 0 Then var = WorksheetFunction.Match(FinalABC_ISIN, rng, 0) If Not IsError(var) Then J = var SHEETNAME1_ISIN = .Range("A" & J).Value ' For every row that has same ISIN re-enable formulae in SHEETNAME1 sheet. ' Convert all formula cells in the row back to formulae. While .Range("A" & J).Value = SHEETNAME1_ISIN .Range("A" & J & ":A" & J).Formula = .Range("A2:A2").FormulaR1C1 .Range("B" & J & ":B" & J).Formula = .Range("B2:B2").FormulaR1C1 .Range("F" & J & ":F" & J).Formula = .Range("F2:F2").FormulaR1C1 .Range("H" & J & ":H" & J).Formula = .Range("H2:H2").FormulaR1C1 .Range("J" & J & ":J" & J).Formula = .Range("J2:J2").FormulaR1C1 .Range("L" & J & ":L" & J).Formula = .Range("L2:L2").FormulaR1C1 .Range("M" & J & ":M" & J).Formula = .Range("M2:M2").FormulaR1C1 .Range("T" & J & ":T" & J).Formula = .Range("T2:T2").FormulaR1C1 .Range("V" & J & ":V" & J).Formula = .Range("V2:V2").FormulaR1C1 .Range("W" & J & ":W" & J).Formula = .Range("W2:W2").FormulaR1C1 .Range("X" & J & ":X" & J).Formula = .Range("X2:X2").FormulaR1C1 .Range("AB" & J & ":AB" & J).Formula = .Range("AB2:AB2").FormulaR1C1 .Range("AC" & J & ":AD" & J).Formula = .Range("AC2:AC2").FormulaR1C1 .Range("AE" & J & ":AE" & J).Formula = .Range("AE2:AE2").FormulaR1C1 .Range("AG" & J & ":AG" & J).Formula = .Range("AG2:AG2").FormulaR1C1 .Range("AH" & J & ":AH" & J).Formula = .Range("AH2:AH2").FormulaR1C1 .Range("AJ" & J & ":AJ" & J).Formula = .Range("AJ2:AJ2").FormulaR1C1 .Range("AK" & J & ":AK" & J).Formula = .Range("AK2:AK2").FormulaR1C1 .Range("AL" & J & ":AL" & J).Formula = .Range("AL2:AL2").FormulaR1C1 .Range("AN" & J & ":AN" & J).Formula = .Range("AN2:AN2").FormulaR1C1 .Range("AO" & J & ":AO" & J).Formula = .Range("AO2:AO2").FormulaR1C1 .Range("AP" & J & ":AP" & J).Formula = .Range("AP2:AP2").FormulaR1C1 .Range("AQ" & J & ":AQ" & J).Formula = .Range("AQ2:AQ2").FormulaR1C1 .Range("AR" & J & ":AR" & J).Formula = .Range("AR2:AR2").FormulaR1C1 .Range("AS" & J & ":AS" & J).Formula = .Range("AS2:AS2").FormulaR1C1 .Range("AT" & J & ":AT" & J).Formula = .Range("AT2:AT2").FormulaR1C1 .Range("AV" & J & ":AV" & J).Formula = .Range("AV2:AV2").FormulaR1C1 .Range("AW" & J & ":AW" & J).Formula = .Range("AW2:AW2").FormulaR1C1 .Range("AX" & J & ":AX" & J).Formula = .Range("AX2:AX2").FormulaR1C1 .Range("AY" & J & ":AY" & J).Formula = .Range("AY2:AY2").FormulaR1C1 .Range("BB" & J & ":BB" & J).Formula = .Range("BB2:BB2").FormulaR1C1 .Range("BD" & J & ":BD" & J).Formula = .Range("BD2:BD2").FormulaR1C1 .Range("BE" & J & ":BE" & J).Formula = .Range("BE2:BE2").FormulaR1C1 .Range("BG" & J & ":BG" & J).Formula = .Range("BG2:BG2").FormulaR1C1 .Range("BH" & J & ":BH" & J).Formula = .Range("BH2:BH2").FormulaR1C1 .Range("BI" & J & ":BI" & J).Formula = .Range("BI2:BI2").FormulaR1C1 .Range("BJ" & J & ":BJ" & J).Formula = .Range("BJ2:BJ2").FormulaR1C1 .Range("BK" & J & ":BK" & J).Formula = .Range("BK2:BK2").FormulaR1C1 .Range("BL" & J & ":BL" & J).Formula = .Range("BL2:BL2").FormulaR1C1 ' Recalculate the entire row. .Range("A" & J & ":BO" & J).Calculate ' next row J = J + 1 Wend Else Message "The ISIN " & SHEETNAME1_ISIN & " cannot be found in the FinalABC sheet." End If End If End With ' Recalculate all worksheets. Application.Calculate ' Now convert all impacted formulae back to values. 'TODO. loop through SHEETNAME1 as above and change formulae to values for any row impacted. ' Convert all formulae on the FinalABC sheet to values. Leaves row 2 alone. If (i > 2) Then ' leave row 2 alone, i.e. leave as formulae. With .Sheets("FinalABC") ' Activate the sheet. .Activate .Range("K" & i & ":K" & i) = .Range("K" & i & ":K" & i).Value .Range("L" & i & ":L" & i) = .Range("L" & i & ":L" & i).Value .Range("M" & i & ":M" & i) = .Range("M" & i & ":M" & i).Value .Range("N" & i & ":N" & i) = .Range("N" & i & ":N" & i).Value .Range("P" & i & ":P" & i) = .Range("P" & i & ":P" & i).Value .Range("Q" & i & ":Q" & i) = .Range("Q" & i & ":Q" & i).Value .Range("AI" & i & ":AI" & i) = .Range("AI" & i & ":AI" & i).Value .Range("AJ" & i & ":AJ" & i) = .Range("AJ" & i & ":AJ" & i).Value .Range("AK" & i & ":AK" & i) = .Range("AK" & i & ":AK" & i).Value .Range("AL" & i & ":AL" & i) = .Range("AL" & i & ":AL" & i).Value .Range("AM" & i & ":AM" & i) = .Range("AM" & i & ":AM" & i).Value .Range("AR" & i & ":AR" & i) = .Range("AR" & i & ":AR" & i).Value .Range("AS" & i & ":AS" & i) = .Range("AS" & i & ":AS" & i).Value .Range("AT" & i & ":AT" & i) = .Range("AT" & i & ":AT" & i).Value End With End If ' Convert all formulae on the SHEETNAME1 sheet to values. Leaves row 2 alone. With .Sheets("SHEETNAME1") ' Activate the sheet. .Activate ' Now get index of first row in SHEETNAME1 sheet that contains same affected ISIN. Set rng = .Range("A1:A" & lastrow_SHEETNAME1) If WorksheetFunction.CountIf(rng, FinalABC_ISIN) > 0 Then var = WorksheetFunction.Match(FinalABC_ISIN, rng, 0) If Not IsError(var) Then J = var SHEETNAME1_ISIN = .Range("A" & J).Value ' For every row that has same ISIN re-enable formulae in SHEETNAME1 sheet. ' Convert all formula cells in the row back to values. While .Range("A" & J).Value = SHEETNAME1_ISIN If (J > 2) Then ' leave row 2 alone, i.e. leave as formulae. .Range("A" & J & ":A" & J) = .Range("A" & J & ":A" & J).Value .Range("B" & J & ":B" & J) = .Range("B" & J & ":B" & J).Value .Range("F" & J & ":F" & J) = .Range("F" & J & ":F" & J).Value .Range("H" & J & ":H" & J) = .Range("H" & J & ":H" & J).Value .Range("J" & J & ":J" & J) = .Range("J" & J & ":J" & J).Value .Range("L" & J & ":L" & J) = .Range("L" & J & ":L" & J).Value .Range("M" & J & ":M" & J) = .Range("M" & J & ":M" & J).Value .Range("T" & J & ":T" & J) = .Range("T" & J & ":T" & J).Value .Range("V" & J & ":V" & J) = .Range("V" & J & ":V" & J).Value .Range("W" & J & ":W" & J) = .Range("W" & J & ":W" & J).Value .Range("X" & J & ":X" & J) = .Range("X" & J & ":X" & J).Value .Range("AB" & J & ":AB" & J) = .Range("AB" & J & ":AB" & J).Value .Range("AC" & J & ":AC" & J) = .Range("AC" & J & ":AC" & J).Value .Range("AE" & J & ":AE" & J) = .Range("AE" & J & ":AE" & J).Value .Range("AG" & J & ":AG" & J) = .Range("AG" & J & ":AG" & J).Value .Range("AH" & J & ":AH" & J) = .Range("AH" & J & ":AH" & J).Value .Range("AJ" & J & ":AJ" & J) = .Range("AJ" & J & ":AJ" & J).Value .Range("AK" & J & ":AK" & J) = .Range("AK" & J & ":AK" & J).Value .Range("AL" & J & ":AL" & J) = .Range("AL" & J & ":AL" & J).Value .Range("AN" & J & ":AN" & J) = .Range("AN" & J & ":AN" & J).Value .Range("AO" & J & ":AO" & J) = .Range("AO" & J & ":AO" & J).Value .Range("AP" & J & ":AP" & J) = .Range("AP" & J & ":AP" & J).Value .Range("AQ" & J & ":AQ" & J) = .Range("AQ" & J & ":AQ" & J).Value .Range("AR" & J & ":AR" & J) = .Range("AR" & J & ":AR" & J).Value .Range("AS" & J & ":AS" & J) = .Range("AS" & J & ":AS" & J).Value .Range("AT" & J & ":AT" & J) = .Range("AT" & J & ":AT" & J).Value .Range("AV" & J & ":AV" & J) = .Range("AV" & J & ":AV" & J).Value .Range("AW" & J & ":AW" & J) = .Range("AW" & J & ":AW" & J).Value .Range("AX" & J & ":AX" & J) = .Range("AX" & J & ":AX" & J).Value .Range("AY" & J & ":AY" & J) = .Range("AY" & J & ":AY" & J).Value .Range("BB" & J & ":BB" & J) = .Range("BB" & J & ":BB" & J).Value .Range("BD" & J & ":BD" & J) = .Range("BD" & J & ":BD" & J).Value .Range("BE" & J & ":BE" & J) = .Range("BE" & J & ":BE" & J).Value .Range("BG" & J & ":BG" & J) = .Range("BG" & J & ":BG" & J).Value .Range("BH" & J & ":BH" & J) = .Range("BH" & J & ":BH" & J).Value .Range("BI" & J & ":BI" & J) = .Range("BI" & J & ":BI" & J).Value .Range("BJ" & J & ":BJ" & J) = .Range("BJ" & J & ":BJ" & J).Value .Range("BK" & J & ":BK" & J) = .Range("BK" & J & ":BK" & J).Value .Range("BL" & J & ":BL" & J) = .Range("BL" & J & ":BL" & J).Value End If ' next row J = J + 1 Wend Else Message "The ISIN " & FinalABC_ISIN & " cannot be found in the SHEETNAME1 sheet." End If End If End With End If Next i End With ' Clear all objects. Set pt = Nothing Set rng = Nothing Set var = Nothing Set working = Nothing Set column_k = Nothing Set column_y = Nothing Set column_ac = Nothing Set column_ad = Nothing Set column_ae = Nothing Set column_af = Nothing Set column_ah = Nothing Set column_ai = Nothing Set column_al = Nothing Set column_am = Nothing Set column_at = Nothing Set column_au = Nothing End Sub ' For any row that has adjusted values different than the original value it recalculates the values against that row. ' It does this by putting formulae back in only for the specific row and then performing the recalc. ' Later the formula are replaced by values again. Sub M11207_Recalc_changed_adjusted_rows_Array_NEW() Dim lastrow_SHEETNAME1 As Long Dim lastrow_FinalABC As Long Dim recalc As Boolean Dim recalc_row As Boolean Dim FinalABC_ISIN As String Dim SHEETNAME1_ISIN As String Dim rng As Range Dim var As Variant Dim i As Long Dim J As Long Dim tmpMonth1 As String Dim tmpMonth2 As String Dim pt As PivotTable Dim column_k As Variant Dim column_y As Variant Dim column_ac As Variant Dim column_ad As Variant Dim column_ae As Variant Dim column_af As Variant Dim column_ah As Variant Dim column_ai As Variant Dim column_al As Variant Dim column_am As Variant Dim column_at As Variant Dim column_au As Variant Dim working As Variant ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Recalc changed adjusted SHEETNAME1 rows?", vbYesNo) = vbNo Then Exit Sub End If With Workbooks(wb_name) ' Get how many rows of data have been loaded into the sheet. lastrow_SHEETNAME1 = .Sheets("SHEETNAME1").Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_SHEETNAME1 < 3 Then lastrow_SHEETNAME1 = 3 End If lastrow_FinalABC = .Sheets("FinalABC").Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_FinalABC < 3 Then lastrow_FinalABC = 3 End If ' Loop through every row in SHEETNAME1 and check if any adjusted cell differs from the original. ' If so then continues with the recalc. recalc = False ReDim working(1 To lastrow_SHEETNAME1, 1) ' Working array ReDim column_k(1 To lastrow_SHEETNAME1, 1) ReDim column_y(1 To lastrow_SHEETNAME1, 1) ReDim column_ac(1 To lastrow_SHEETNAME1, 1) ReDim column_ad(1 To lastrow_SHEETNAME1, 1) ReDim column_ae(1 To lastrow_SHEETNAME1, 1) ReDim column_af(1 To lastrow_SHEETNAME1, 1) ReDim column_ah(1 To lastrow_SHEETNAME1, 1) ReDim column_ai(1 To lastrow_SHEETNAME1, 1) ReDim column_al(1 To lastrow_SHEETNAME1, 1) ReDim column_am(1 To lastrow_SHEETNAME1, 1) ReDim column_at(1 To lastrow_SHEETNAME1, 1) ReDim column_au(1 To lastrow_SHEETNAME1, 1) ' Check SHEETNAME1 for changes. With .Sheets("SHEETNAME1") ' Activate the sheet. .Activate ' Load working with dummy values - just to set its size. working = .Range("D1:D" & lastrow_SHEETNAME1) ' Load SHEETNAME1 columns into array variables. column_k = .Range("K1:K" & lastrow_SHEETNAME1) column_y = .Range("Y1:Y" & lastrow_SHEETNAME1) column_ac = .Range("AC1:AC" & lastrow_SHEETNAME1) column_ad = .Range("AD1:AD" & lastrow_SHEETNAME1) column_ae = .Range("AE1:AE" & lastrow_SHEETNAME1) column_af = .Range("AF1:AF" & lastrow_SHEETNAME1) column_ah = .Range("AH1:AH" & lastrow_SHEETNAME1) column_ai = .Range("AI1:AI" & lastrow_SHEETNAME1) column_al = .Range("AL1:AL" & lastrow_SHEETNAME1) column_am = .Range("AM1:AM" & lastrow_SHEETNAME1) column_at = .Range("AT1:AT" & lastrow_SHEETNAME1) column_au = .Range("AU1:AU" & lastrow_SHEETNAME1) ' Prompt the user for the row to change i = Application.InputBox _ (Prompt:="Please enter which line to recalc in the SHEETNAME1 sheet.", _ Title:="SHEETNAME1 line to recalc", Type:=1) If i < LBound(working) Then GoTo IncorrectRow End If If i > UBound(working) Then GoTo IncorrectRow End If 'For i = LBound(working) To UBound(working) ' If row 1, heading, skip If i = 1 Then GoTo IncorrectRow ' next i End If ' Default to false recalc_row = False ' Tax rate adjusted. If column_k(i, 1) <> "" Then recalc_row = True End If ' Include / Exclude. If column_y(i, 1) <> "INCLUDE" Then recalc_row = True End If ' Income Code Adjusted. If column_ad(i, 1) <> "" Then If column_ad(i, 1) <> column_ac(i, 1) Then recalc_row = True End If End If ' Exemption Code Adjusted. If column_af(i, 1) <> "" Then If column_af(i, 1) <> column_ae(i, 1) Then recalc_row = True End If End If ' BBH Rate Adjusted. If column_ai(i, 1) <> "" Then If column_ai(i, 1) <> column_ah(i, 1) Then recalc_row = True End If End If ' BBH CCY Adjusted. If column_am(i, 1) <> "" Then If column_am(i, 1) <> column_al(i, 1) Then recalc_row = True End If End If ' Suggested Rate Adjusted. If column_au(i, 1) <> "" Then If column_au(i, 1) <> column_at(i, 1) Then recalc_row = True End If End If ' Check if recalc_row is true. If recalc_row = True Then ' Set recalc to true recalc = True ' Get starting position of the affected ISIN within the SHEETNAME1 sheet. SHEETNAME1_ISIN = .Range("A" & i).Value ' Convert all formula cells in the row back to formulae. .Range("A" & i & ":A" & i).Formula = .Range("A2:A2").FormulaR1C1 .Range("B" & i & ":B" & i).Formula = .Range("B2:B2").FormulaR1C1 .Range("F" & i & ":F" & i).Formula = .Range("F2:F2").FormulaR1C1 .Range("H" & i & ":H" & i).Formula = .Range("H2:H2").FormulaR1C1 .Range("J" & i & ":J" & i).Formula = .Range("J2:J2").FormulaR1C1 .Range("L" & i & ":L" & i).Formula = .Range("L2:L2").FormulaR1C1 .Range("M" & i & ":M" & i).Formula = .Range("M2:M2").FormulaR1C1 .Range("T" & i & ":T" & i).Formula = .Range("T2:T2").FormulaR1C1 .Range("V" & i & ":V" & i).Formula = .Range("V2:V2").FormulaR1C1 .Range("W" & i & ":W" & i).Formula = .Range("W2:W2").FormulaR1C1 .Range("X" & i & ":X" & i).Formula = .Range("X2:X2").FormulaR1C1 .Range("AB" & i & ":AB" & i).Formula = .Range("AB2:AB2").FormulaR1C1 .Range("AC" & i & ":AC" & i).Formula = .Range("AC2:AC2").FormulaR1C1 .Range("AE" & i & ":AE" & i).Formula = .Range("AE2:AE2").FormulaR1C1 .Range("AG" & i & ":AG" & i).Formula = .Range("AG2:AG2").FormulaR1C1 .Range("AH" & i & ":AH" & i).Formula = .Range("AH2:AH2").FormulaR1C1 .Range("AJ" & i & ":AJ" & i).Formula = .Range("AJ2:AJ2").FormulaR1C1 .Range("AK" & i & ":AK" & i).Formula = .Range("AK2:AK2").FormulaR1C1 .Range("AL" & i & ":AL" & i).Formula = .Range("AL2:AL2").FormulaR1C1 .Range("AN" & i & ":AN" & i).Formula = .Range("AN2:AN2").FormulaR1C1 .Range("AO" & i & ":AO" & i).Formula = .Range("AO2:AO2").FormulaR1C1 .Range("AP" & i & ":AP" & i).Formula = .Range("AP2:AP2").FormulaR1C1 .Range("AQ" & i & ":AQ" & i).Formula = .Range("AQ2:AQ2").FormulaR1C1 .Range("AR" & i & ":AR" & i).Formula = .Range("AR2:AR2").FormulaR1C1 .Range("AS" & i & ":AS" & i).Formula = .Range("AS2:AS2").FormulaR1C1 .Range("AT" & i & ":AT" & i).Formula = .Range("AT2:AT2").FormulaR1C1 .Range("AV" & i & ":AU" & i).Formula = .Range("AV2:AV2").FormulaR1C1 .Range("AW" & i & ":AW" & i).Formula = .Range("AW2:AW2").FormulaR1C1 .Range("AX" & i & ":AX" & i).Formula = .Range("AX2:AX2").FormulaR1C1 .Range("AY" & i & ":AY" & i).Formula = .Range("AY2:AY2").FormulaR1C1 .Range("BB" & i & ":BB" & i).Formula = .Range("BB2:BB2").FormulaR1C1 .Range("BD" & i & ":BD" & i).Formula = .Range("BD2:BD2").FormulaR1C1 .Range("BE" & i & ":BE" & i).Formula = .Range("BE2:BE2").FormulaR1C1 .Range("BG" & i & ":BG" & i).Formula = .Range("BG2:BG2").FormulaR1C1 .Range("BH" & i & ":BH" & i).Formula = .Range("BH2:BH2").FormulaR1C1 .Range("BI" & i & ":BI" & i).Formula = .Range("BI2:BI2").FormulaR1C1 .Range("BJ" & i & ":BJ" & i).Formula = .Range("BJ2:JI2").FormulaR1C1 .Range("BK" & i & ":BK" & i).Formula = .Range("BK2:BK2").FormulaR1C1 .Range("BL" & i & ":BL" & i).Formula = .Range("BL2:BL2").FormulaR1C1 ' Recalculate the entire row. .Range("A" & i & ":BO" & i).Calculate '-------------------------------------------------------------------------- ' TODO - Add in here loop for all affected lines in FinalABC sheet with same ISIN. ' Then we can remove the below copy all BBH formulae down. ' Now get index of first row in FinalABC sheet that contains same affected ISIN. With Sheets("FinalABC") Set rng = .Range("A1:A" & lastrow_FinalABC) If WorksheetFunction.CountIf(rng, SHEETNAME1_ISIN) > 0 Then var = WorksheetFunction.Match(SHEETNAME1_ISIN, rng, 0) If Not IsError(var) Then J = var FinalABC_ISIN = .Range("A" & J).Value ' For every row that has same ISIN re-enable formulae in SHEETNAME1 sheet. ' Convert all formula cells in the row back to formulae. While .Range("A" & J).Value = FinalABC_ISIN ' Convert all formula cells in the row back to formulae. .Range("K" & J & ":K" & J).Formula = .Range("K2:K2").FormulaR1C1 .Range("L" & J & ":L" & J).Formula = .Range("L2:L2").FormulaR1C1 .Range("M" & J & ":M" & J).Formula = .Range("M2:M2").FormulaR1C1 .Range("N" & J & ":N" & J).Formula = .Range("N2:N2").FormulaR1C1 .Range("P" & J & ":P" & J).Formula = .Range("P2:P2").FormulaR1C1 .Range("Q" & J & ":Q" & J).Formula = .Range("Q2:Q2").FormulaR1C1 .Range("AI" & J & ":AI" & J).Formula = .Range("AI2:AI2").FormulaR1C1 .Range("AJ" & J & ":AJ" & J).Formula = .Range("AJ2:AJ2").FormulaR1C1 .Range("AK" & J & ":AK" & J).Formula = .Range("AK2:AK2").FormulaR1C1 .Range("AL" & J & ":AL" & J).Formula = .Range("AL2:AL2").FormulaR1C1 .Range("AM" & J & ":AM" & J).Formula = .Range("AM2:AM2").FormulaR1C1 .Range("AR" & J & ":AR" & J).Formula = .Range("AR2:AR2").FormulaR1C1 .Range("AS" & J & ":AS" & J).Formula = .Range("AS2:AS2").FormulaR1C1 .Range("AT" & J & ":AT" & J).Formula = .Range("AT2:AT2").FormulaR1C1 ' Recalculate the entire row. .Range("A" & J & ":AT" & J).Calculate ' Convert all formulae on the FinalABC sheet to values. Leaves row 2 alone. If (J > 2) Then .Range("K" & J & ":K" & J) = .Range("K" & J & ":K" & J).Value .Range("L" & J & ":L" & J) = .Range("L" & J & ":L" & J).Value .Range("M" & J & ":M" & J) = .Range("M" & J & ":M" & J).Value .Range("N" & J & ":N" & J) = .Range("N" & J & ":N" & J).Value .Range("P" & J & ":P" & J) = .Range("P" & J & ":P" & J).Value .Range("Q" & J & ":Q" & J) = .Range("Q" & J & ":Q" & J).Value .Range("AI" & J & ":AI" & J) = .Range("AI" & J & ":AI" & J).Value .Range("AJ" & J & ":AJ" & J) = .Range("AJ" & J & ":AJ" & J).Value .Range("AK" & J & ":AK" & J) = .Range("AK" & J & ":AK" & J).Value .Range("AL" & J & ":AL" & J) = .Range("AL" & J & ":AL" & J).Value .Range("AM" & J & ":AM" & J) = .Range("AM" & J & ":AM" & J).Value .Range("AR" & J & ":AR" & J) = .Range("AR" & J & ":AR" & J).Value .Range("AS" & J & ":AS" & J) = .Range("AS" & J & ":AS" & J).Value .Range("AT" & J & ":AT" & J) = .Range("AT" & J & ":AT" & J).Value End If ' next row J = J + 1 Wend Else Message "The ISIN " & SHEETNAME1_ISIN & " cannot be found in the FinalABC sheet." End If End If End With ' Convert all formulae on the SHEETNAME1 sheet to values. Leaves row 2 alone. If (i > 2) Then .Range("A" & i & ":A" & i) = .Range("A" & i & ":A" & i).Value .Range("B" & i & ":B" & i) = .Range("B" & i & ":B" & i).Value .Range("F" & i & ":F" & i) = .Range("F" & i & ":F" & i).Value .Range("H" & i & ":H" & i) = .Range("H" & i & ":H" & i).Value .Range("J" & i & ":J" & i) = .Range("J" & i & ":J" & i).Value .Range("L" & i & ":L" & i) = .Range("L" & i & ":L" & i).Value .Range("M" & i & ":M" & i) = .Range("M" & i & ":M" & i).Value .Range("T" & i & ":T" & i) = .Range("T" & i & ":T" & i).Value .Range("V" & i & ":V" & i) = .Range("V" & i & ":V" & i).Value .Range("W" & i & ":W" & i) = .Range("W" & i & ":W" & i).Value .Range("X" & i & ":X" & i) = .Range("X" & i & ":X" & i).Value .Range("AB" & i & ":AB" & i) = .Range("AB" & i & ":AB" & i).Value .Range("AC" & i & ":AC" & i) = .Range("AC" & i & ":AC" & i).Value .Range("AE" & i & ":AE" & i) = .Range("AE" & i & ":AE" & i).Value .Range("AG" & i & ":AG" & i) = .Range("AG" & i & ":AG" & i).Value .Range("AH" & i & ":AH" & i) = .Range("AH" & i & ":AH" & i).Value .Range("AJ" & i & ":AJ" & i) = .Range("AJ" & i & ":AJ" & i).Value .Range("AK" & i & ":AK" & i) = .Range("AK" & i & ":AK" & i).Value .Range("AL" & i & ":AL" & i) = .Range("AL" & i & ":AL" & i).Value .Range("AN" & i & ":AN" & i) = .Range("AN" & i & ":AN" & i).Value .Range("AO" & i & ":AO" & i) = .Range("AO" & i & ":AO" & i).Value .Range("AP" & i & ":AP" & i) = .Range("AP" & i & ":AP" & i).Value .Range("AQ" & i & ":AQ" & i) = .Range("AQ" & i & ":AQ" & i).Value .Range("AR" & i & ":AR" & i) = .Range("AR" & i & ":AR" & i).Value .Range("AS" & i & ":AS" & i) = .Range("AS" & i & ":AS" & i).Value .Range("AT" & i & ":AT" & i) = .Range("AT" & i & ":AT" & i).Value .Range("AV" & i & ":AV" & i) = .Range("AV" & i & ":AV" & i).Value .Range("AW" & i & ":AW" & i) = .Range("AW" & i & ":AW" & i).Value .Range("AX" & i & ":AX" & i) = .Range("AX" & i & ":AX" & i).Value .Range("AY" & i & ":AY" & i) = .Range("AY" & i & ":AY" & i).Value .Range("BB" & i & ":BB" & i) = .Range("BB" & i & ":BB" & i).Value .Range("BD" & i & ":BD" & i) = .Range("BD" & i & ":BD" & i).Value .Range("BE" & i & ":BE" & i) = .Range("BE" & i & ":BE" & i).Value .Range("BG" & i & ":BG" & i) = .Range("BG" & i & ":BG" & i).Value .Range("BH" & i & ":BH" & i) = .Range("BH" & i & ":BH" & i).Value .Range("BI" & i & ":BI" & i) = .Range("BI" & i & ":BI" & i).Value .Range("BJ" & i & ":BJ" & i) = .Range("BJ" & i & ":BJ" & i).Value .Range("BK" & i & ":BK" & i) = .Range("BK" & i & ":BK" & i).Value .Range("BL" & i & ":BL" & i) = .Range("BL" & i & ":BL" & i).Value End If '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ End If IncorrectRow: 'Next i End With If recalc = True Then ' Do refresh of pivots. With Sheets("Mapping Pivots") ' Activate the Mapping Pivots sheet. .Activate ' Refresh the pivot tables. For Each pt In .PivotTables pt.RefreshTable pt.Update Next End With End If End With ' Clear all objects. Set pt = Nothing Set rng = Nothing Set var = Nothing Set working = Nothing Set column_k = Nothing Set column_y = Nothing Set column_ac = Nothing Set column_ad = Nothing Set column_ae = Nothing Set column_af = Nothing Set column_ah = Nothing Set column_ai = Nothing Set column_al = Nothing Set column_am = Nothing Set column_at = Nothing Set column_au = Nothing End Sub ' For any row that has adjusted values different than the original value it recalculates the values against that row. ' It does this by putting formulae back in only for the specific row and then performing the recalc. ' Later the formula are replaced by values again. Sub M11208_Recalc_changed_adjusted_rows_Array_NEW() Dim lastrow_SHEETNAME1 As Long Dim lastrow_FinalABC As Long Dim recalc As Boolean Dim recalc_row As Boolean Dim FinalABC_ISIN As String Dim SHEETNAME1_ISIN As String Dim rng As Range Dim var As Variant Dim i As Long Dim J As Long Dim tmpMonth1 As String Dim tmpMonth2 As String Dim pt As PivotTable Dim column_k As Variant Dim column_y As Variant Dim column_ac As Variant Dim column_ad As Variant Dim column_ae As Variant Dim column_af As Variant Dim column_ah As Variant Dim column_ai As Variant Dim column_al As Variant Dim column_am As Variant Dim column_at As Variant Dim column_au As Variant Dim working As Variant ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Recalc changed adjusted FinalABC rows?", vbYesNo) = vbNo Then Exit Sub End If With Workbooks(wb_name) ' Get how many rows of data have been loaded into the sheet. lastrow_SHEETNAME1 = .Sheets("SHEETNAME1").Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_SHEETNAME1 < 3 Then lastrow_SHEETNAME1 = 3 End If lastrow_FinalABC = .Sheets("FinalABC").Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_FinalABC < 3 Then lastrow_FinalABC = 3 End If ' Loop through every row in SHEETNAME1 and check if any adjusted cell differs from the original. ' If so then continues with the recalc. recalc = False ReDim working(1 To lastrow_SHEETNAME1, 1) ' Working array ReDim column_k(1 To lastrow_SHEETNAME1, 1) ReDim column_y(1 To lastrow_SHEETNAME1, 1) ReDim column_ac(1 To lastrow_SHEETNAME1, 1) ReDim column_ad(1 To lastrow_SHEETNAME1, 1) ReDim column_ae(1 To lastrow_SHEETNAME1, 1) ReDim column_af(1 To lastrow_SHEETNAME1, 1) ReDim column_ah(1 To lastrow_SHEETNAME1, 1) ReDim column_ai(1 To lastrow_SHEETNAME1, 1) ReDim column_al(1 To lastrow_SHEETNAME1, 1) ReDim column_am(1 To lastrow_SHEETNAME1, 1) ReDim column_at(1 To lastrow_SHEETNAME1, 1) ReDim column_au(1 To lastrow_SHEETNAME1, 1) If recalc = True Then ' Do refresh of pivots. With Sheets("Mapping Pivots") ' Activate the Mapping Pivots sheet. .Activate ' Refresh the pivot tables. For Each pt In .PivotTables pt.RefreshTable pt.Update Next End With End If '********************************************************************************************* ' Check FinalABC for adjustment changes. ' Loop through every row in SHEETNAME1 and check if any adjusted cell differs from the original. ' If so then continues with the recalc. i = Application.InputBox _ (Prompt:="Please enter which line to recalc in the FinalABC sheet.", _ Title:="FinalABC line to recalc", Type:=1) If i < LBound(working) Then GoTo IncorrectRow End If If i > UBound(working) Then GoTo IncorrectRow End If 'For i = 2 To lastrow_FinalABC ' Default to false recalc_row = False recalc = False ' Check FinalABC for changes. With .Sheets("FinalABC") ' Activate the sheet. .Activate ' USD Adjustments. If .Range("J" & i).Value <> "" Then recalc_row = True End If ' Tax Rate Adjusted If .Range("R" & i).Value <> "" Then recalc_row = True End If ' Adjusted date. tmpMonth1 = UCase(Left(.Range("F" & i).Value, 3)) tmpMonth2 = UCase(Left(Right(.Range("A" & i).Value, 8), 3)) If (tmpMonth1 <> tmpMonth2) Then recalc_row = True End If ' Check if recalc_row is true. If recalc_row = True Then ' Set recalc to true recalc = True ' Convert all formula cells in the row back to formulae. .Range("K" & i & ":K" & i).Formula = .Range("K2:K2").FormulaR1C1 .Range("L" & i & ":L" & i).Formula = .Range("L2:L2").FormulaR1C1 .Range("M" & i & ":M" & i).Formula = .Range("M2:M2").FormulaR1C1 .Range("N" & i & ":N" & i).Formula = .Range("N2:N2").FormulaR1C1 .Range("P" & i & ":P" & i).Formula = .Range("P2:P2").FormulaR1C1 .Range("Q" & i & ":Q" & i).Formula = .Range("Q2:Q2").FormulaR1C1 .Range("AI" & i & ":AI" & i).Formula = .Range("AI2:AI2").FormulaR1C1 .Range("AJ" & i & ":AJ" & i).Formula = .Range("AJ2:AJ2").FormulaR1C1 .Range("AK" & i & ":AK" & i).Formula = .Range("AK2:AK2").FormulaR1C1 .Range("AL" & i & ":AL" & i).Formula = .Range("AL2:AL2").FormulaR1C1 .Range("AM" & i & ":AM" & i).Formula = .Range("AM2:AM2").FormulaR1C1 .Range("AR" & i & ":AR" & i).Formula = .Range("AR2:AR2").FormulaR1C1 .Range("AS" & i & ":AS" & i).Formula = .Range("AS2:AS2").FormulaR1C1 .Range("AT" & i & ":AT" & i).Formula = .Range("AT2:AT2").FormulaR1C1 ' Recalculate the entire row. .Range("A" & i & ":AT" & i).Calculate ' Get starting position of the affected ISIN within the SHEETNAME1 sheet. FinalABC_ISIN = .Range("A" & i).Value End If End With If recalc = True Then ' Do refresh of Mapping pivots With .Sheets("Mapping Pivots") ' Activate the sheet. .Activate ' Refresh the pivots. For Each pt In .PivotTables pt.RefreshTable pt.Update Next End With ' Now get index of first row in SHEETNAME1 sheet that contains same affected ISIN. With .Sheets("SHEETNAME1") Set rng = .Range("A1:A" & lastrow_SHEETNAME1) If WorksheetFunction.CountIf(rng, FinalABC_ISIN) > 0 Then var = WorksheetFunction.Match(FinalABC_ISIN, rng, 0) If Not IsError(var) Then J = var SHEETNAME1_ISIN = .Range("A" & J).Value ' For every row that has same ISIN re-enable formulae in SHEETNAME1 sheet. ' Convert all formula cells in the row back to formulae. While .Range("A" & J).Value = SHEETNAME1_ISIN .Range("A" & J & ":A" & J).Formula = .Range("A2:A2").FormulaR1C1 .Range("B" & J & ":B" & J).Formula = .Range("B2:B2").FormulaR1C1 .Range("F" & J & ":F" & J).Formula = .Range("F2:F2").FormulaR1C1 .Range("H" & J & ":H" & J).Formula = .Range("H2:H2").FormulaR1C1 .Range("J" & J & ":J" & J).Formula = .Range("J2:J2").FormulaR1C1 .Range("L" & J & ":L" & J).Formula = .Range("L2:L2").FormulaR1C1 .Range("M" & J & ":M" & J).Formula = .Range("M2:M2").FormulaR1C1 .Range("T" & J & ":T" & J).Formula = .Range("T2:T2").FormulaR1C1 .Range("V" & J & ":V" & J).Formula = .Range("V2:V2").FormulaR1C1 .Range("W" & J & ":W" & J).Formula = .Range("W2:W2").FormulaR1C1 .Range("X" & J & ":X" & J).Formula = .Range("X2:X2").FormulaR1C1 .Range("AB" & J & ":AB" & J).Formula = .Range("AB2:AB2").FormulaR1C1 .Range("AC" & J & ":AD" & J).Formula = .Range("AC2:AC2").FormulaR1C1 .Range("AE" & J & ":AE" & J).Formula = .Range("AE2:AE2").FormulaR1C1 .Range("AG" & J & ":AG" & J).Formula = .Range("AG2:AG2").FormulaR1C1 .Range("AH" & J & ":AH" & J).Formula = .Range("AH2:AH2").FormulaR1C1 .Range("AJ" & J & ":AJ" & J).Formula = .Range("AJ2:AJ2").FormulaR1C1 .Range("AK" & J & ":AK" & J).Formula = .Range("AK2:AK2").FormulaR1C1 .Range("AL" & J & ":AL" & J).Formula = .Range("AL2:AL2").FormulaR1C1 .Range("AN" & J & ":AN" & J).Formula = .Range("AN2:AN2").FormulaR1C1 .Range("AO" & J & ":AO" & J).Formula = .Range("AO2:AO2").FormulaR1C1 .Range("AP" & J & ":AP" & J).Formula = .Range("AP2:AP2").FormulaR1C1 .Range("AQ" & J & ":AQ" & J).Formula = .Range("AQ2:AQ2").FormulaR1C1 .Range("AR" & J & ":AR" & J).Formula = .Range("AR2:AR2").FormulaR1C1 .Range("AS" & J & ":AS" & J).Formula = .Range("AS2:AS2").FormulaR1C1 .Range("AT" & J & ":AT" & J).Formula = .Range("AT2:AT2").FormulaR1C1 .Range("AV" & J & ":AV" & J).Formula = .Range("AV2:AV2").FormulaR1C1 .Range("AW" & J & ":AW" & J).Formula = .Range("AW2:AW2").FormulaR1C1 .Range("AX" & J & ":AX" & J).Formula = .Range("AX2:AX2").FormulaR1C1 .Range("AY" & J & ":AY" & J).Formula = .Range("AY2:AY2").FormulaR1C1 .Range("BB" & J & ":BB" & J).Formula = .Range("BB2:BB2").FormulaR1C1 .Range("BD" & J & ":BD" & J).Formula = .Range("BD2:BD2").FormulaR1C1 .Range("BE" & J & ":BE" & J).Formula = .Range("BE2:BE2").FormulaR1C1 .Range("BG" & J & ":BG" & J).Formula = .Range("BG2:BG2").FormulaR1C1 .Range("BH" & J & ":BH" & J).Formula = .Range("BH2:BH2").FormulaR1C1 .Range("BI" & J & ":BI" & J).Formula = .Range("BI2:BI2").FormulaR1C1 .Range("BJ" & J & ":BJ" & J).Formula = .Range("BJ2:BJ2").FormulaR1C1 .Range("BK" & J & ":BK" & J).Formula = .Range("BK2:BK2").FormulaR1C1 .Range("BL" & J & ":BL" & J).Formula = .Range("BL2:BL2").FormulaR1C1 ' Recalculate the entire row. .Range("A" & J & ":BO" & J).Calculate ' next row J = J + 1 Wend Else Message "The ISIN " & SHEETNAME1_ISIN & " cannot be found in the FinalABC sheet." End If End If End With ' Recalculate all worksheets. Application.Calculate ' Now convert all impacted formulae back to values. 'TODO. loop through SHEETNAME1 as above and change formulae to values for any row impacted. ' Convert all formulae on the FinalABC sheet to values. Leaves row 2 alone. If (i > 2) Then ' leave row 2 alone, i.e. leave as formulae. With .Sheets("FinalABC") ' Activate the sheet. .Activate .Range("K" & i & ":K" & i) = .Range("K" & i & ":K" & i).Value .Range("L" & i & ":L" & i) = .Range("L" & i & ":L" & i).Value .Range("M" & i & ":M" & i) = .Range("M" & i & ":M" & i).Value .Range("N" & i & ":N" & i) = .Range("N" & i & ":N" & i).Value .Range("P" & i & ":P" & i) = .Range("P" & i & ":P" & i).Value .Range("Q" & i & ":Q" & i) = .Range("Q" & i & ":Q" & i).Value .Range("AI" & i & ":AI" & i) = .Range("AI" & i & ":AI" & i).Value .Range("AJ" & i & ":AJ" & i) = .Range("AJ" & i & ":AJ" & i).Value .Range("AK" & i & ":AK" & i) = .Range("AK" & i & ":AK" & i).Value .Range("AL" & i & ":AL" & i) = .Range("AL" & i & ":AL" & i).Value .Range("AM" & i & ":AM" & i) = .Range("AM" & i & ":AM" & i).Value .Range("AR" & i & ":AR" & i) = .Range("AR" & i & ":AR" & i).Value .Range("AS" & i & ":AS" & i) = .Range("AS" & i & ":AS" & i).Value .Range("AT" & i & ":AT" & i) = .Range("AT" & i & ":AT" & i).Value End With End If ' Convert all formulae on the SHEETNAME1 sheet to values. Leaves row 2 alone. With .Sheets("SHEETNAME1") ' Activate the sheet. .Activate ' Now get index of first row in SHEETNAME1 sheet that contains same affected ISIN. Set rng = .Range("A1:A" & lastrow_SHEETNAME1) If WorksheetFunction.CountIf(rng, FinalABC_ISIN) > 0 Then var = WorksheetFunction.Match(FinalABC_ISIN, rng, 0) If Not IsError(var) Then J = var SHEETNAME1_ISIN = .Range("A" & J).Value ' For every row that has same ISIN re-enable formulae in SHEETNAME1 sheet. ' Convert all formula cells in the row back to values. While .Range("A" & J).Value = SHEETNAME1_ISIN If (J > 2) Then ' leave row 2 alone, i.e. leave as formulae. .Range("A" & J & ":A" & J) = .Range("A" & J & ":A" & J).Value .Range("B" & J & ":B" & J) = .Range("B" & J & ":B" & J).Value .Range("F" & J & ":F" & J) = .Range("F" & J & ":F" & J).Value .Range("H" & J & ":H" & J) = .Range("H" & J & ":H" & J).Value .Range("J" & J & ":J" & J) = .Range("J" & J & ":J" & J).Value .Range("L" & J & ":L" & J) = .Range("L" & J & ":L" & J).Value .Range("M" & J & ":M" & J) = .Range("M" & J & ":M" & J).Value .Range("T" & J & ":T" & J) = .Range("T" & J & ":T" & J).Value .Range("V" & J & ":V" & J) = .Range("V" & J & ":V" & J).Value .Range("W" & J & ":W" & J) = .Range("W" & J & ":W" & J).Value .Range("X" & J & ":X" & J) = .Range("X" & J & ":X" & J).Value .Range("AB" & J & ":AB" & J) = .Range("AB" & J & ":AB" & J).Value .Range("AC" & J & ":AC" & J) = .Range("AC" & J & ":AC" & J).Value .Range("AE" & J & ":AE" & J) = .Range("AE" & J & ":AE" & J).Value .Range("AG" & J & ":AG" & J) = .Range("AG" & J & ":AG" & J).Value .Range("AH" & J & ":AH" & J) = .Range("AH" & J & ":AH" & J).Value .Range("AJ" & J & ":AJ" & J) = .Range("AJ" & J & ":AJ" & J).Value .Range("AK" & J & ":AK" & J) = .Range("AK" & J & ":AK" & J).Value .Range("AL" & J & ":AL" & J) = .Range("AL" & J & ":AL" & J).Value .Range("AN" & J & ":AN" & J) = .Range("AN" & J & ":AN" & J).Value .Range("AO" & J & ":AO" & J) = .Range("AO" & J & ":AO" & J).Value .Range("AP" & J & ":AP" & J) = .Range("AP" & J & ":AP" & J).Value .Range("AQ" & J & ":AQ" & J) = .Range("AQ" & J & ":AQ" & J).Value .Range("AR" & J & ":AR" & J) = .Range("AR" & J & ":AR" & J).Value .Range("AS" & J & ":AS" & J) = .Range("AS" & J & ":AS" & J).Value .Range("AT" & J & ":AT" & J) = .Range("AT" & J & ":AT" & J).Value .Range("AV" & J & ":AV" & J) = .Range("AV" & J & ":AV" & J).Value .Range("AW" & J & ":AW" & J) = .Range("AW" & J & ":AW" & J).Value .Range("AX" & J & ":AX" & J) = .Range("AX" & J & ":AX" & J).Value .Range("AY" & J & ":AY" & J) = .Range("AY" & J & ":AY" & J).Value .Range("BB" & J & ":BB" & J) = .Range("BB" & J & ":BB" & J).Value .Range("BD" & J & ":BD" & J) = .Range("BD" & J & ":BD" & J).Value .Range("BE" & J & ":BE" & J) = .Range("BE" & J & ":BE" & J).Value .Range("BG" & J & ":BG" & J) = .Range("BG" & J & ":BG" & J).Value .Range("BH" & J & ":BH" & J) = .Range("BH" & J & ":BH" & J).Value .Range("BI" & J & ":BI" & J) = .Range("BI" & J & ":BI" & J).Value .Range("BJ" & J & ":BJ" & J) = .Range("BJ" & J & ":BJ" & J).Value .Range("BK" & J & ":BK" & J) = .Range("BK" & J & ":BK" & J).Value .Range("BL" & J & ":BL" & J) = .Range("BL" & J & ":BL" & J).Value End If ' next row J = J + 1 Wend Else Message "The ISIN " & FinalABC_ISIN & " cannot be found in the SHEETNAME1 sheet." End If End If End With End If IncorrectRow: 'Next i End With ' Clear all objects. Set pt = Nothing Set rng = Nothing Set var = Nothing Set working = Nothing Set column_k = Nothing Set column_y = Nothing Set column_ac = Nothing Set column_ad = Nothing Set column_ae = Nothing Set column_af = Nothing Set column_ah = Nothing Set column_ai = Nothing Set column_al = Nothing Set column_am = Nothing Set column_at = Nothing Set column_au = Nothing End Sub ' For any row that has adjusted values different than the original value it recalculates the values against that row. ' It does this by putting formulae back in only for the specific row and then performing the recalc. ' Later the formula are replaced by values again. Sub M11210_Recalc_changed_adjusted_rows() Dim lastrow_SHEETNAME1 As Long Dim lastrow_FinalABC As Long Dim sheet As Worksheet Dim recalc As Boolean Dim recalc_row As Boolean Dim FinalABC_ISIN As String Dim SHEETNAME1_ISIN As String Dim rng As Range Dim var As Variant Dim i As Long Dim J As Long Dim tmpMonth1 As String Dim tmpMonth2 As String Dim pt As PivotTable ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Recalc changed adjusted SHEETNAME1 rows?", vbYesNo) = vbNo Then Exit Sub End If With Workbooks(wb_name) ' Get how many rows of data have been loaded into the sheet. lastrow_SHEETNAME1 = .Sheets("SHEETNAME1").Cells(Rows.Count, 4).End(xlUp).Row lastrow_FinalABC = .Sheets("FinalABC").Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_SHEETNAME1 < 3 Then lastrow_SHEETNAME1 = 3 End If If lastrow_FinalABC < 3 Then lastrow_FinalABC = 3 End If ' Loop through every row in SHEETNAME1 and check if any adjusted cell differs from the original. ' If so then continues with the recalc. recalc = False ' Check SHEETNAME1 for changes. With .Sheets("SHEETNAME1") ' Activate the sheet. .Activate For i = 2 To lastrow_SHEETNAME1 'For i = lastrow To lastrow ' for testing area below. ' Default to false recalc_row = False ' Tax rate adjusted. If .Range("K" & i).Text <> "" Then recalc_row = True End If ' Include / Exclude If .Range("Y" & i).Text <> "INCLUDE" Then recalc_row = True End If ' Income Code Adjusted. If .Range("AD" & i).Text <> .Range("AC" & i).Text Then recalc_row = True End If ' Exemption Code Adjusted. If .Range("AF" & i).Text <> .Range("AE" & i).Text Then recalc_row = True End If ' BBH Rate Adjusted. If .Range("AI" & i).Text <> .Range("AH" & i).Text Then recalc_row = True End If ' BBH CCY Adjusted. If .Range("AM" & i).Text <> .Range("AL" & i).Text Then recalc_row = True End If ' Suggested Rate Adjusted. If .Range("AU" & i).Text <> .Range("AT" & i).Text Then recalc_row = True End If ' Check if recalc_row is true. If recalc_row = True Then ' Set recalc to true recalc = True ' Convert all formula cells in the row back to formulae. .Range("A" & i & ":A" & i).Formula = .Range("A2:A2").FormulaR1C1 .Range("B" & i & ":B" & i).Formula = .Range("B2:B2").FormulaR1C1 .Range("F" & i & ":F" & i).Formula = .Range("F2:F2").FormulaR1C1 .Range("H" & i & ":H" & i).Formula = .Range("H2:H2").FormulaR1C1 .Range("J" & i & ":J" & i).Formula = .Range("J2:J2").FormulaR1C1 .Range("L" & i & ":L" & i).Formula = .Range("L2:L2").FormulaR1C1 .Range("M" & i & ":M" & i).Formula = .Range("M2:M2").FormulaR1C1 .Range("T" & i & ":T" & i).Formula = .Range("T2:T2").FormulaR1C1 .Range("V" & i & ":V" & i).Formula = .Range("V2:V2").FormulaR1C1 .Range("W" & i & ":W" & i).Formula = .Range("W2:W2").FormulaR1C1 .Range("X" & i & ":X" & i).Formula = .Range("X2:X2").FormulaR1C1 .Range("AB" & i & ":AB" & i).Formula = .Range("AB2:AB2").FormulaR1C1 .Range("AC" & i & ":AC" & i).Formula = .Range("AC2:AC2").FormulaR1C1 .Range("AE" & i & ":AE" & i).Formula = .Range("AE2:AE2").FormulaR1C1 .Range("AG" & i & ":AG" & i).Formula = .Range("AG2:AG2").FormulaR1C1 .Range("AH" & i & ":AH" & i).Formula = .Range("AH2:AH2").FormulaR1C1 .Range("AJ" & i & ":AJ" & i).Formula = .Range("AJ2:AJ2").FormulaR1C1 .Range("AK" & i & ":AK" & i).Formula = .Range("AK2:AK2").FormulaR1C1 .Range("AL" & i & ":AL" & i).Formula = .Range("AL2:AL2").FormulaR1C1 .Range("AN" & i & ":AN" & i).Formula = .Range("AN2:AN2").FormulaR1C1 .Range("AO" & i & ":AO" & i).Formula = .Range("AO2:AO2").FormulaR1C1 .Range("AP" & i & ":AP" & i).Formula = .Range("AP2:AP2").FormulaR1C1 .Range("AQ" & i & ":AQ" & i).Formula = .Range("AQ2:AQ2").FormulaR1C1 .Range("AR" & i & ":AR" & i).Formula = .Range("AR2:AR2").FormulaR1C1 .Range("AS" & i & ":AS" & i).Formula = .Range("AS2:AS2").FormulaR1C1 .Range("AT" & i & ":AT" & i).Formula = .Range("AT2:AT2").FormulaR1C1 .Range("AV" & i & ":AV" & i).Formula = .Range("AV2:AV2").FormulaR1C1 .Range("AW" & i & ":AW" & i).Formula = .Range("AW2:AW2").FormulaR1C1 .Range("AX" & i & ":AX" & i).Formula = .Range("AX2:AX2").FormulaR1C1 .Range("AY" & i & ":AY" & i).Formula = .Range("AY2:AY2").FormulaR1C1 .Range("BB" & i & ":BB" & i).Formula = .Range("BB2:BB2").FormulaR1C1 .Range("BD" & i & ":BD" & i).Formula = .Range("BD2:BD2").FormulaR1C1 .Range("BE" & i & ":BE" & i).Formula = .Range("BE2:BE2").FormulaR1C1 .Range("BG" & i & ":BG" & i).Formula = .Range("BG2:BG2").FormulaR1C1 .Range("BH" & i & ":BH" & i).Formula = .Range("BH2:BH2").FormulaR1C1 .Range("BI" & i & ":BI" & i).Formula = .Range("BI2:BI2").FormulaR1C1 .Range("BJ" & i & ":BJ" & i).Formula = .Range("BJ2:BJ2").FormulaR1C1 .Range("BK" & i & ":BK" & i).Formula = .Range("BK2:BK2").FormulaR1C1 .Range("BL" & i & ":BL" & i).Formula = .Range("BL2:BL2").FormulaR1C1 ' Recalculate the entire row. .Range("A" & i & ":BO" & i).Calculate End If Next i End With If recalc = True Then ' Refresh all impacted formula on the FinalABC sheet. With Sheets("FinalABC") ' Activate the FinalABC sheet. .Activate .Range("K2:K2").AutoFill Destination:=.Range("K2:K" & lastrow_FinalABC) .Range("L2:L2").AutoFill Destination:=.Range("L2:L" & lastrow_FinalABC) .Range("M2:M2").AutoFill Destination:=.Range("M2:M" & lastrow_FinalABC) .Range("N2:N2").AutoFill Destination:=.Range("N2:N" & lastrow_FinalABC) .Range("P2:P2").AutoFill Destination:=.Range("P2:P" & lastrow_FinalABC) .Range("Q2:Q2").AutoFill Destination:=.Range("Q2:Q" & lastrow_FinalABC) .Range("AI2:AI2").AutoFill Destination:=.Range("AI2:AI" & lastrow_FinalABC) .Range("AJ2:AJ2").AutoFill Destination:=.Range("AJ2:AJ" & lastrow_FinalABC) .Range("AK2:AK2").AutoFill Destination:=.Range("AK2:AK" & lastrow_FinalABC) .Range("AL2:AL2").AutoFill Destination:=.Range("AL2:AL" & lastrow_FinalABC) .Range("AM2:AM2").AutoFill Destination:=.Range("AM2:AM" & lastrow_FinalABC) .Range("AR2:AR2").AutoFill Destination:=.Range("AR2:AR" & lastrow_FinalABC) .Range("AS2:AS2").AutoFill Destination:=.Range("AS2:AS" & lastrow_FinalABC) .Range("AT2:AT2").AutoFill Destination:=.Range("AT2:AT" & lastrow_FinalABC) ' Recalculate the entire row. '.Range("AK2:AK" & FinalABC_lastrow).Calculate End With ' Recalculate all worksheets. Application.Calculate ' Do refresh of pivots. With Sheets("Mapping Pivots") ' Activate the Mapping Pivots sheet. .Activate ' Refresh the pivot tables. For Each pt In .PivotTables pt.RefreshTable pt.Update Next End With ' Recalculate all worksheets again to pick up Pivot values. Application.Calculate ' Now convert all impacted formulae back to values. 'TODO. loop through SHEETNAME1 as above and change formulae to values for any row impacted. ' Convert all formulae on the FinalABC sheet to values. Leaves row 2 alone. With Sheets("FinalABC") ' Activate the sheet. .Activate .Range("K3:K" & lastrow_FinalABC) = .Range("K3:K" & lastrow_FinalABC).Value .Range("L3:L" & lastrow_FinalABC) = .Range("L3:L" & lastrow_FinalABC).Value .Range("M3:M" & lastrow_FinalABC) = .Range("M3:M" & lastrow_FinalABC).Value .Range("N3:N" & lastrow_FinalABC) = .Range("N3:N" & lastrow_FinalABC).Value .Range("P3:P" & lastrow_FinalABC) = .Range("P3:P" & lastrow_FinalABC).Value .Range("Q3:Q" & lastrow_FinalABC) = .Range("Q3:Q" & lastrow_FinalABC).Value .Range("AI3:AI" & lastrow_FinalABC) = .Range("AI3:AI" & lastrow_FinalABC).Value .Range("AJ3:AJ" & lastrow_FinalABC) = .Range("AJ3:AJ" & lastrow_FinalABC).Value .Range("AK3:AK" & lastrow_FinalABC) = .Range("AK3:AK" & lastrow_FinalABC).Value .Range("AL3:AL" & lastrow_FinalABC) = .Range("AL3:AL" & lastrow_FinalABC).Value .Range("AM3:AM" & lastrow_FinalABC) = .Range("AM3:AM" & lastrow_FinalABC).Value .Range("AR3:AR" & lastrow_FinalABC) = .Range("AR3:AR" & lastrow_FinalABC).Value .Range("AS3:AS" & lastrow_FinalABC) = .Range("AS3:AS" & lastrow_FinalABC).Value .Range("AT3:AT" & lastrow_FinalABC) = .Range("AT3:AT" & lastrow_FinalABC).Value End With End If ' Convert all formulae on the SHEETNAME1 sheet to values. Leaves row 2 alone. ' Loop through every row in SHEETNAME1 and check if any adjusted cell differs from the original. ' If so then continues with the changing of the formula back to values. recalc = False For i = 2 To lastrow_SHEETNAME1 ' Default to false recalc_row = False ' Check SHEETNAME1 for changes. With .Sheets("SHEETNAME1") ' Tax rate adjusted. If .Range("K" & i).Text <> "" Then recalc_row = True End If ' Include / Exclude If .Range("Y" & i).Text <> "INCLUDE" Then recalc_row = True End If ' Income Code Adjusted. If .Range("AD" & i).Text <> .Range("AC" & i).Text Then recalc_row = True End If ' Exemption Code Adjusted. If .Range("AF" & i).Text <> .Range("AE" & i).Text Then recalc_row = True End If ' BBH Rate Adjusted. If .Range("AI" & i).Text <> .Range("AH" & i).Text Then recalc_row = True End If ' BBH CCY Adjusted. If .Range("AM" & i).Text <> .Range("AL" & i).Text Then recalc_row = True End If ' Suggested Rate Adjusted. If .Range("AU" & i).Text <> .Range("AT" & i).Text Then recalc_row = True End If ' Check if recalc_row is true. If recalc_row = True Then ' Set recalc to true 'recalc = True If (i > 2) Then ' leave row 2 alone, i.e. leave as formulae. .Range("A" & i & ":A" & i) = .Range("A" & i & ":A" & i).Value .Range("B" & i & ":B" & i) = .Range("B" & i & ":B" & i).Value .Range("F" & i & ":F" & i) = .Range("F" & i & ":F" & i).Value .Range("H" & i & ":H" & i) = .Range("H" & i & ":H" & i).Value .Range("J" & i & ":J" & i) = .Range("J" & i & ":J" & i).Value .Range("L" & i & ":L" & i) = .Range("L" & i & ":L" & i).Value .Range("M" & i & ":M" & i) = .Range("M" & i & ":L" & i).Value .Range("T" & i & ":T" & i) = .Range("T" & i & ":T" & i).Value .Range("V" & i & ":V" & i) = .Range("V" & i & ":V" & i).Value .Range("W" & i & ":W" & i) = .Range("W" & i & ":W" & i).Value .Range("X" & i & ":X" & i) = .Range("X" & i & ":X" & i).Value .Range("AB" & i & ":AB" & i) = .Range("AB" & i & ":AB" & i).Value .Range("AC" & i & ":AC" & i) = .Range("AC" & i & ":AC" & i).Value .Range("AE" & i & ":AE" & i) = .Range("AE" & i & ":AE" & i).Value .Range("AG" & i & ":AG" & i) = .Range("AG" & i & ":AG" & i).Value .Range("AH" & i & ":AH" & i) = .Range("AH" & i & ":AG" & i).Value .Range("AJ" & i & ":AJ" & i) = .Range("AJ" & i & ":AH" & i).Value .Range("AK" & i & ":AK" & i) = .Range("AK" & i & ":AK" & i).Value .Range("AL" & i & ":AL" & i) = .Range("AL" & i & ":AL" & i).Value .Range("AN" & i & ":AN" & i) = .Range("AN" & i & ":AN" & i).Value .Range("AO" & i & ":AO" & i) = .Range("AO" & i & ":AO" & i).Value .Range("AP" & i & ":AP" & i) = .Range("AP" & i & ":AP" & i).Value .Range("AQ" & i & ":AQ" & i) = .Range("AQ" & i & ":AQ" & i).Value .Range("AR" & i & ":AR" & i) = .Range("AR" & i & ":AR" & i).Value .Range("AS" & i & ":AS" & i) = .Range("AS" & i & ":AS" & i).Value .Range("AT" & i & ":AT" & i) = .Range("AT" & i & ":AT" & i).Value .Range("AV" & i & ":AV" & i) = .Range("AV" & i & ":AV" & i).Value .Range("AW" & i & ":AW" & i) = .Range("AW" & i & ":AW" & i).Value .Range("AX" & i & ":AX" & i) = .Range("AX" & i & ":AX" & i).Value .Range("AY" & i & ":AY" & i) = .Range("AY" & i & ":AY" & i).Value .Range("BB" & i & ":BB" & i) = .Range("BB" & i & ":BB" & i).Value .Range("BD" & i & ":BD" & i) = .Range("BD" & i & ":BD" & i).Value .Range("BE" & i & ":BE" & i) = .Range("BE" & i & ":BE" & i).Value .Range("BG" & i & ":BG" & i) = .Range("BG" & i & ":BG" & i).Value .Range("BH" & i & ":BH" & i) = .Range("BH" & i & ":BH" & i).Value .Range("BI" & i & ":BI" & i) = .Range("BI" & i & ":BI" & i).Value .Range("BJ" & i & ":BJ" & i) = .Range("BJ" & i & ":BJ" & i).Value .Range("BK" & i & ":BK" & i) = .Range("BK" & i & ":BK" & i).Value .Range("BL" & i & ":BL" & i) = .Range("BL" & i & ":BL" & i).Value End If End If End With Next i '********************************************************************************************* ' Check FinalABC for adjustment changes. ' Loop through every row in SHEETNAME1 and check if any adjusted cell differs from the original. ' If so then continues with the recalc. recalc = False For i = 2 To lastrow_FinalABC ' Default to false recalc_row = False ' Check FinalABC for changes. With .Sheets("FinalABC") ' Activate the sheet. .Activate ' USD Adjustments. If .Range("J" & i).Value <> "" Then recalc_row = True End If ' Adjusted date. tmpMonth1 = UCase(Left(.Range("F" & i).Value, 3)) tmpMonth2 = UCase(Left(Right(.Range("A" & i).Value, 8), 3)) If (tmpMonth1 <> tmpMonth2) Then recalc_row = True End If ' Check if recalc_row is true. If recalc_row = True Then ' Set recalc to true recalc = True ' Convert all formula cells in the row back to formulae. .Range("K" & i & ":K" & i).Formula = .Range("K2:K2").FormulaR1C1 .Range("L" & i & ":L" & i).Formula = .Range("L2:L2").FormulaR1C1 .Range("M" & i & ":M" & i).Formula = .Range("M2:M2").FormulaR1C1 .Range("N" & i & ":N" & i).Formula = .Range("N2:N2").FormulaR1C1 .Range("P" & i & ":P" & i).Formula = .Range("P2:P2").FormulaR1C1 .Range("Q" & i & ":Q" & i).Formula = .Range("Q2:Q2").FormulaR1C1 .Range("AI" & i & ":AI" & i).Formula = .Range("AI2:AI2").FormulaR1C1 .Range("AJ" & i & ":AJ" & i).Formula = .Range("AJ2:AJ2").FormulaR1C1 .Range("AK" & i & ":AK" & i).Formula = .Range("AK2:AK2").FormulaR1C1 .Range("AL" & i & ":AL" & i).Formula = .Range("AL2:AL2").FormulaR1C1 .Range("AM" & i & ":AM" & i).Formula = .Range("AM2:AM2").FormulaR1C1 .Range("AR" & i & ":AR" & i).Formula = .Range("AR2:AR2").FormulaR1C1 .Range("AS" & i & ":AS" & i).Formula = .Range("AS2:AS2").FormulaR1C1 .Range("AT" & i & ":AT" & i).Formula = .Range("AT2:AT2").FormulaR1C1 ' Recalculate the entire row. .Range("A" & i & ":AR" & i).Calculate ' Get starting position of the affected ISIN within the SHEETNAME1 sheet. FinalABC_ISIN = .Range("A" & i).Value End If End With ' Do refresh of Mapping pivots With .Sheets("Mapping Pivots") ' Activate the sheet. .Activate ' Refresh the pivots. For Each pt In .PivotTables pt.RefreshTable pt.Update Next End With ' Now get index of first row in SHEETNAME1 sheet that contains same affected ISIN. With .Sheets("SHEETNAME1") Set rng = .Range("A1:A" & lastrow_SHEETNAME1) If WorksheetFunction.CountIf(rng, FinalABC_ISIN) > 0 Then var = WorksheetFunction.Match(FinalABC_ISIN, rng, 0) If Not IsError(var) Then J = var SHEETNAME1_ISIN = .Range("A" & J).Value ' For every row that has same ISIN re-enable formulae in SHEETNAME1 sheet. ' Convert all formula cells in the row back to formulae. While .Range("A" & J).Value = SHEETNAME1_ISIN .Range("A" & J & ":A" & J).Formula = .Range("A2:A2").FormulaR1C1 .Range("B" & J & ":B" & J).Formula = .Range("B2:B2").FormulaR1C1 .Range("F" & J & ":F" & J).Formula = .Range("F2:F2").FormulaR1C1 .Range("H" & J & ":H" & J).Formula = .Range("H2:H2").FormulaR1C1 .Range("J" & J & ":J" & J).Formula = .Range("J2:J2").FormulaR1C1 .Range("L" & J & ":L" & J).Formula = .Range("L2:L2").FormulaR1C1 .Range("M" & J & ":M" & J).Formula = .Range("M2:M2").FormulaR1C1 .Range("T" & J & ":T" & J).Formula = .Range("T2:T2").FormulaR1C1 .Range("V" & J & ":V" & J).Formula = .Range("V2:V2").FormulaR1C1 .Range("W" & J & ":W" & J).Formula = .Range("W2:W2").FormulaR1C1 .Range("X" & J & ":X" & J).Formula = .Range("X2:X2").FormulaR1C1 .Range("AB" & J & ":AB" & J).Formula = .Range("AB2:AB2").FormulaR1C1 .Range("AC" & J & ":AC" & J).Formula = .Range("AC2:AC2").FormulaR1C1 .Range("AE" & J & ":AE" & J).Formula = .Range("AE2:AE2").FormulaR1C1 .Range("AG" & J & ":AG" & J).Formula = .Range("AG2:AG2").FormulaR1C1 .Range("AH" & J & ":AH" & J).Formula = .Range("AH2:AH2").FormulaR1C1 .Range("AJ" & J & ":AJ" & J).Formula = .Range("AJ2:AJ2").FormulaR1C1 .Range("AK" & J & ":AK" & J).Formula = .Range("AK2:AK2").FormulaR1C1 .Range("AL" & J & ":AL" & J).Formula = .Range("AL2:AL2").FormulaR1C1 .Range("AN" & J & ":AN" & J).Formula = .Range("AN2:AN2").FormulaR1C1 .Range("AO" & J & ":AO" & J).Formula = .Range("AO2:AO2").FormulaR1C1 .Range("AP" & J & ":AP" & J).Formula = .Range("AP2:AP2").FormulaR1C1 .Range("AQ" & J & ":AQ" & J).Formula = .Range("AQ2:AQ2").FormulaR1C1 .Range("AR" & J & ":AR" & J).Formula = .Range("AR2:AR2").FormulaR1C1 .Range("AS" & J & ":AS" & J).Formula = .Range("AS2:AS2").FormulaR1C1 .Range("AT" & J & ":AT" & J).Formula = .Range("AT2:AT2").FormulaR1C1 .Range("AV" & J & ":AV" & J).Formula = .Range("AV2:AV2").FormulaR1C1 .Range("AW" & J & ":AW" & J).Formula = .Range("AW2:AW2").FormulaR1C1 .Range("AX" & J & ":AX" & J).Formula = .Range("AX2:AX2").FormulaR1C1 .Range("AY" & J & ":AY" & J).Formula = .Range("AY2:AY2").FormulaR1C1 .Range("BB" & J & ":BB" & J).Formula = .Range("BB2:BB2").FormulaR1C1 .Range("BD" & J & ":BD" & J).Formula = .Range("BD2:BD2").FormulaR1C1 .Range("BE" & J & ":BE" & J).Formula = .Range("BE2:BE2").FormulaR1C1 .Range("BG" & J & ":BG" & J).Formula = .Range("BG2:BG2").FormulaR1C1 .Range("BH" & J & ":BH" & J).Formula = .Range("BH2:BH2").FormulaR1C1 .Range("BI" & J & ":BI" & J).Formula = .Range("BI2:BI2").FormulaR1C1 .Range("BJ" & J & ":BJ" & J).Formula = .Range("BJ2:BJ2").FormulaR1C1 .Range("BK" & J & ":BK" & J).Formula = .Range("BK2:BK2").FormulaR1C1 .Range("BL" & J & ":BL" & J).Formula = .Range("BL2:BL2").FormulaR1C1 ' Recalculate the entire row. .Range("A" & J & ":BO" & J).Calculate ' next row J = J + 1 Wend Else MsgBox ("The ISIN " & FinalABC_ISIN & " cannot be found in the SHEETNAME1 sheet.") End If End If End With ' Recalculate all worksheets. Application.Calculate ' Now convert all impacted formulae back to values. 'TODO. loop through SHEETNAME1 as above and change formulae to values for any row impacted. ' Convert all formulae on the FinalABC sheet to values. Leaves row 2 alone. If (i > 2) Then ' leave row 2 alone, i.e. leave as formulae. With .Sheets("FinalABC") ' Activate the sheet. .Activate .Range("K" & i & ":K" & i) = .Range("K" & i & ":K" & i).Value .Range("L" & i & ":L" & i) = .Range("L" & i & ":L" & i).Value .Range("M" & i & ":M" & i) = .Range("M" & i & ":M" & i).Value .Range("N" & i & ":N" & i) = .Range("N" & i & ":N" & i).Value .Range("P" & i & ":P" & i) = .Range("P" & i & ":P" & i).Value .Range("Q" & i & ":Q" & i) = .Range("Q" & i & ":Q" & i).Value .Range("AI" & i & ":AI" & i) = .Range("AI" & i & ":AI" & i).Value .Range("AJ" & i & ":AJ" & i) = .Range("AJ" & i & ":AJ" & i).Value .Range("AK" & i & ":AK" & i) = .Range("AK" & i & ":AK" & i).Value .Range("AL" & i & ":AL" & i) = .Range("AL" & i & ":AL" & i).Value .Range("AM" & i & ":AM" & i) = .Range("AM" & i & ":AM" & i).Value .Range("AR" & i & ":AR" & i) = .Range("AR" & i & ":AR" & i).Value .Range("AS" & i & ":AS" & i) = .Range("AS" & i & ":AS" & i).Value .Range("AT" & i & ":AT" & i) = .Range("AT" & i & ":AT" & i).Value End With End If ' Convert all formulae on the SHEETNAME1 sheet to values. Leaves row 2 alone. 'With Workbooks(my1042Rec).Sheets("SHEETNAME1") ' .Range("A3:A" & lastrow) = .Range("A3:A" & lastrow).Value ' .Range("B3:B" & lastrow) = .Range("B3:B" & lastrow).Value ' '... ' '... 'End With ' Convert all formulae on the SHEETNAME1 sheet to values. Leaves row 2 alone. With .Sheets("SHEETNAME1") ' Activate the sheet. .Activate ' Now get index of first row in SHEETNAME1 sheet that contains same affected ISIN. Set rng = .Range("A1:A" & lastrow_SHEETNAME1) If WorksheetFunction.CountIf(rng, FinalABC_ISIN) > 0 Then var = WorksheetFunction.Match(FinalABC_ISIN, rng, 0) If Not IsError(var) Then J = var SHEETNAME1_ISIN = .Range("A" & J).Value ' For every row that has same ISIN re-enable formulae in SHEETNAME1 sheet. ' Convert all formula cells in the row back to values. While .Range("A" & J).Value = SHEETNAME1_ISIN If (J > 2) Then ' leave row 2 alone, i.e. leave as formulae. .Range("A" & J & ":A" & J) = .Range("A" & J & ":A" & J).Value .Range("B" & J & ":B" & J) = .Range("B" & J & ":B" & J).Value .Range("F" & J & ":F" & J) = .Range("F" & J & ":F" & J).Value .Range("H" & J & ":H" & J) = .Range("H" & J & ":H" & J).Value .Range("J" & J & ":J" & J) = .Range("J" & J & ":J" & J).Value .Range("L" & J & ":L" & J) = .Range("L" & J & ":L" & J).Value .Range("M" & J & ":M" & J) = .Range("M" & J & ":M" & J).Value .Range("T" & J & ":T" & J) = .Range("T" & J & ":T" & J).Value .Range("V" & J & ":V" & J) = .Range("V" & J & ":V" & J).Value .Range("W" & J & ":W" & J) = .Range("W" & J & ":W" & J).Value .Range("X" & J & ":X" & J) = .Range("X" & J & ":X" & J).Value .Range("AB" & J & ":AB" & J) = .Range("AB" & J & ":AB" & J).Value .Range("AC" & J & ":AC" & J) = .Range("AC" & J & ":AC" & J).Value .Range("AE" & J & ":AE" & J) = .Range("AE" & J & ":AE" & J).Value .Range("AG" & J & ":AG" & J) = .Range("AG" & J & ":AG" & J).Value .Range("AH" & J & ":AH" & J) = .Range("AH" & J & ":AH" & J).Value .Range("AJ" & J & ":AJ" & J) = .Range("AJ" & J & ":AJ" & J).Value .Range("AK" & J & ":AK" & J) = .Range("AK" & J & ":AK" & J).Value .Range("AL" & J & ":AL" & J) = .Range("AL" & J & ":AL" & J).Value .Range("AN" & J & ":AN" & J) = .Range("AN" & J & ":AN" & J).Value .Range("AO" & J & ":AO" & J) = .Range("AO" & J & ":AO" & J).Value .Range("AP" & J & ":AP" & J) = .Range("AP" & J & ":AP" & J).Value .Range("AQ" & J & ":AQ" & J) = .Range("AQ" & J & ":AQ" & J).Value .Range("AR" & J & ":AR" & J) = .Range("AR" & J & ":AR" & J).Value .Range("AS" & J & ":AS" & J) = .Range("AS" & J & ":AS" & J).Value .Range("AT" & J & ":AT" & J) = .Range("AT" & J & ":AT" & J).Value .Range("AV" & J & ":AV" & J) = .Range("AV" & J & ":AV" & J).Value .Range("AW" & J & ":AW" & J) = .Range("AW" & J & ":AW" & J).Value .Range("AX" & J & ":AX" & J) = .Range("AX" & J & ":AX" & J).Value .Range("AY" & J & ":AY" & J) = .Range("AY" & J & ":AY" & J).Value .Range("BB" & J & ":BB" & J) = .Range("BB" & J & ":BB" & J).Value .Range("BD" & J & ":BD" & J) = .Range("BD" & J & ":BD" & J).Value .Range("BE" & J & ":BE" & J) = .Range("BE" & J & ":BE" & J).Value .Range("BG" & J & ":BG" & J) = .Range("BG" & J & ":BG" & J).Value .Range("BH" & J & ":BH" & J) = .Range("BH" & J & ":BH" & J).Value .Range("BI" & J & ":BI" & J) = .Range("BI" & J & ":BI" & J).Value .Range("BJ" & J & ":BJ" & J) = .Range("BJ" & J & ":BJ" & J).Value .Range("BK" & J & ":BK" & J) = .Range("BK" & J & ":BK" & J).Value .Range("BL" & J & ":BL" & J) = .Range("BL" & J & ":BL" & J).Value End If ' next row J = J + 1 Wend Else MsgBox ("The ISIN " & FinalABC_ISIN & " cannot be found in the SHEETNAME1 sheet.") End If End If End With Next i End With ' Clear all objects. Set pt = Nothing End Sub '************************************************************************************************* '************************************************************************************************* '************************************************************************************************* '************************************************************************************************* '************************************************************************************************* '************************************************************************************************* '************************************************************************************************* '************************************************************************************************* '************************************************************************************************* ' Copies all formulae down on the FinalABC sheet. ' Does not calculate. This needs to be requested separately when needed. Probably only once the SHEETNAME1 sheet populated too. ' Does not change the formula to values. For that use the separate subroutine. ' This may run for a very long time. Go have a coffee. Sub M12000_Copy_FinalABC_Formulae_Down() Dim mycell As Variant Dim lastrow_FinalABC As Long Dim Pmt_Curr As Variant Dim FX_Rate As Variant ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Copy all FinalABC formulae down?", vbYesNo) = vbNo Then Exit Sub End If With Workbooks(wb_name) With .Sheets("FinalABC") ' Activate the sheet. .Activate ' Get how many rows of data have been loaded into the sheet. 'lastrow = Workbooks(my1042Rec).Sheets("FinalABC").Range("D65536").End(xlUp).Row lastrow_FinalABC = .Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_FinalABC < 3 Then lastrow_FinalABC = 3 End If ' Ensure that FX_Rate has a default value. 'For Each mycell In Workbooks(my1042Rec).Sheets("FinalABC").Range("AC2", Range("AC65536").End(xlUp)) For Each mycell In .Range("AE2:AE" & lastrow_FinalABC) If Not mycell Like "*[0-9]*" Then mycell.Formula = 1 Next mycell ' Copies formulae down. .Range("A2:C2").AutoFill Destination:=.Range("A2:C" & lastrow_FinalABC) .Range("E2").AutoFill Destination:=.Range("E2:E" & lastrow_FinalABC) .Range("K2:N2").AutoFill Destination:=.Range("K2:N" & lastrow_FinalABC) .Range("P2:Q2").AutoFill Destination:=.Range("P2:Q" & lastrow_FinalABC) .Range("AI2:AM2").AutoFill Destination:=.Range("AI2:AM" & lastrow_FinalABC) .Range("AR2:AT2").AutoFill Destination:=.Range("AR2:AT" & lastrow_FinalABC) ' Calculations. ' .Range("K2:N" & lastrow_FinalABC).Calculate ' .Range("P2:P" & lastrow_FinalABC).Calculate ' .Range("E2:E" & lastrow_FinalABC).Calculate ' .Range("A2:C" & lastrow_FinalABC).Calculate ' .Range("AG2:AK" & lastrow_FinalABC).Calculate ' .Range("AP2:AR" & lastrow_FinalABC).Calculate ' Now copy and paste formula ranges as values to speed up the file processing. ' .Range("E3:E" & lastrow_FinalABC) = .Range("E3:E" & lastrow_FinalABC).Value ' .Range("K3:N" & lastrow_FinalABC) = .Range("K3:N" & lastrow_FinalABC).Value ' .Range("A3:C" & lastrow_FinalABC) = .Range("A3:C" & lastrow_FinalABC).Value ' .Range("P3:P" & lastrow_FinalABC) = .Range("P3:P" & lastrow_FinalABC).Value ' .Range("AG3:AK" & lastrow_FinalABC) = .Range("AG3:AK" & lastrow_FinalABC).Value ' .Range("AP3:AR" & lastrow_FinalABC) = .Range("AP3:AR" & lastrow_FinalABC).Value 'For Each Pmt_Curr In Sheets("FinalABC").Range("G2", Range("H65536").End(xlUp).Offset(0, -1)) 'For Each Pmt_Curr In Sheets("FinalABC").Range("G2", Range("G65536").End(xlUp)) For Each Pmt_Curr In Sheets("FinalABC").Range("G2:G" & lastrow_FinalABC) If RTrim(LTrim(Pmt_Curr)) = "" Then Pmt_Curr.Value = "USD" Next Pmt_Curr 'For Each FX_Rate In Sheets("FinalABC").Range("AE2", Range("AE65536").End(xlUp).Offset(0, -1)) 'For Each FX_Rate In Sheets("FinalABC").Range("AE2", Range("AE65536").End(xlUp)) For Each FX_Rate In Sheets("FinalABC").Range("AE2:AE" & lastrow_FinalABC) If IsNumeric(FX_Rate) = False Then FX_Rate.Value = 1 Next FX_Rate ' Select A1. ScrollTo ActiveSheet.name, "A1" End With End With ' Clear all objects. Set mycell = Nothing Set Pmt_Curr = Nothing Set FX_Rate = Nothing End Sub ' Converts all formulae on the FinalABC sheet to Values. ' Does not change row 2 of the FinalABC sheet. This retains the formulae in this row. ' This may run for a very long time. Go have a coffee. Sub M12010_Convert_FinalABC_Formulae_to_Values() Dim lastrow_FinalABC As Long ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Convert all FinalABC formulae to Values?", vbYesNo) = vbNo Then Exit Sub End If With Workbooks(wb_name) With .Sheets("FinalABC") ' Activate the sheet. .Activate ' Get how many rows of data have been loaded into the sheet. 'lastrow = .Range("D65536").End(xlUp).Row lastrow_FinalABC = .Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_FinalABC < 3 Then lastrow_FinalABC = 3 End If ' Now copy and paste formula ranges as values to speed up the file processing. .Range("A3:C" & lastrow_FinalABC) = .Range("A3:C" & lastrow_FinalABC).Value .Range("E3:E" & lastrow_FinalABC) = .Range("E3:E" & lastrow_FinalABC).Value .Range("K3:N" & lastrow_FinalABC) = .Range("K3:N" & lastrow_FinalABC).Value .Range("P3:Q" & lastrow_FinalABC) = .Range("P3:Q" & lastrow_FinalABC).Value .Range("AI3:AM" & lastrow_FinalABC) = .Range("AI3:AM" & lastrow_FinalABC).Value .Range("AR3:AT" & lastrow_FinalABC) = .Range("AR3:AT" & lastrow_FinalABC).Value ' Select A1. ScrollTo ActiveSheet.name, "A1" End With End With End Sub ' Copies down all formulae on the SHEETNAME1 sheet. ' Does not change the formula to values. For that use the separate subroutine. ' Does not calculate. This needs to be requested separately when needed. Probably only once the FinalABC sheet populated too. ' This may run for a very long time. Go have a coffee. Sub M12020_Copy_SHEETNAME1_Formulae_Down() Dim lastrow_SHEETNAME1 As Long ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Copy all SHEETNAME1 formulae down?", vbYesNo) = vbNo Then Exit Sub End If With Workbooks(wb_name) With .Sheets("SHEETNAME1") ' Activate the sheet. .Activate ' Get how many rows of data have been loaded into the sheet. 'lastrow = .Range("D65536").End(xlUp).Row lastrow_SHEETNAME1 = .Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_SHEETNAME1 < 3 Then lastrow_SHEETNAME1 = 3 End If ' Copies formulae down. .Range("A2:B2").AutoFill Destination:=.Range("A2:B" & lastrow_SHEETNAME1) .Range("F2:F2").AutoFill Destination:=.Range("F2:F" & lastrow_SHEETNAME1) .Range("H2:H2").AutoFill Destination:=.Range("H2:H" & lastrow_SHEETNAME1) .Range("J2:J2").AutoFill Destination:=.Range("J2:J" & lastrow_SHEETNAME1) .Range("L2:L2").AutoFill Destination:=.Range("L2:L" & lastrow_SHEETNAME1) .Range("T2:T2").AutoFill Destination:=.Range("T2:T" & lastrow_SHEETNAME1) .Range("V2:X2").AutoFill Destination:=.Range("V2:X" & lastrow_SHEETNAME1) .Range("AB2:AC2").AutoFill Destination:=.Range("AB2:AC" & lastrow_SHEETNAME1) .Range("AE2:AE2").AutoFill Destination:=.Range("AE2:AE" & lastrow_SHEETNAME1) .Range("AG2:AH2").AutoFill Destination:=.Range("AG2:AH" & lastrow_SHEETNAME1) .Range("AJ2:AL2").AutoFill Destination:=.Range("AJ2:AL" & lastrow_SHEETNAME1) .Range("AN2:AT2").AutoFill Destination:=.Range("AN2:AT" & lastrow_SHEETNAME1) .Range("AV2:AY2").AutoFill Destination:=.Range("AV2:AY" & lastrow_SHEETNAME1) .Range("BB2:BB2").AutoFill Destination:=.Range("BB2:BB" & lastrow_SHEETNAME1) .Range("BD2:BE2").AutoFill Destination:=.Range("BD2:BE" & lastrow_SHEETNAME1) .Range("BG2:BL2").AutoFill Destination:=.Range("BG2:BL" & lastrow_SHEETNAME1) .Range("BM2:BM2").AutoFill Destination:=.Range("BM2:BM" & lastrow_SHEETNAME1) ' Calculations. '.Range("A2", Range("B" & lastrow_SHEETNAME1 + 1).End(xlUp).Offset(0, 0)).Calculate '.Range("A2:B" & lastrow_SHEETNAME1).Calculate '.Range("F2:F" & lastrow_SHEETNAME1).Calculate '.Range("H2:H" & lastrow_SHEETNAME1).Calculate '.Range("J2:L" & lastrow_SHEETNAME1).Calculate '.Range("S2:S" & lastrow_SHEETNAME1).Calculate '.Range("U2:W" & lastrow_SHEETNAME1).Calculate '.Range("AA2:AB" & lastrow_SHEETNAME1).Calculate '.Range("AD2:AD" & lastrow_SHEETNAME1).Calculate '.Range("AF2:AG" & lastrow_SHEETNAME1).Calculate '.Range("AI2:AK" & lastrow_SHEETNAME1).Calculate '.Range("AM2:AS" & lastrow_SHEETNAME1).Calculate '.Range("AU2:AX" & lastrow_SHEETNAME1).Calculate '.Range("BA2:BA" & lastrow_SHEETNAME1).Calculate '.Range("BC2:BD" & lastrow_SHEETNAME1).Calculate '.Range("BF2:BK" & lastrow_SHEETNAME1).Calculate '.Range("BL2:BL" & lastrow_SHEETNAME1).Calculate ' Now copy and paste formula ranges as values to speed up the file processing. '.Range("A3:A" & lastrow_SHEETNAME1) = .Range("A3:A" & lastrow_SHEETNAME1).Value '.Range("B3:B" & lastrow_SHEETNAME1) = .Range("B3:B" & lastrow_SHEETNAME1).Value '.Range("F3:F" & lastrow_SHEETNAME1) = .Range("F3:F" & lastrow_SHEETNAME1).Value '.Range("H3:H" & lastrow_SHEETNAME1) = .Range("H3:H" & lastrow_SHEETNAME1).Value '.Range("J3:J" & lastrow_SHEETNAME1) = .Range("J3:J" & lastrow_SHEETNAME1).Value '.Range("K3:K" & lastrow_SHEETNAME1) = .Range("K3:K" & lastrow_SHEETNAME1).Value '.Range("L3:L" & lastrow_SHEETNAME1) = .Range("L3:L" & lastrow_SHEETNAME1).Value '.Range("S3:S" & lastrow_SHEETNAME1) = .Range("S3:S" & lastrow_SHEETNAME1).Value '.Range("U3:U" & lastrow_SHEETNAME1) = .Range("U3:U" & lastrow_SHEETNAME1).Value '.Range("V3:V" & lastrow_SHEETNAME1) = .Range("V3:V" & lastrow_SHEETNAME1).Value '.Range("W3:W" & lastrow_SHEETNAME1) = .Range("W3:W" & lastrow_SHEETNAME1).Value '.Range("AA3:AA" & lastrow_SHEETNAME1) = .Range("AA3:AA" & lastrow_SHEETNAME1).Value '.Range("AB3:AB" & lastrow_SHEETNAME1) = .Range("AB3:AB" & lastrow_SHEETNAME1).Value '.Range("AD3:AD" & lastrow_SHEETNAME1) = .Range("AD3:AD" & lastrow_SHEETNAME1).Value '.Range("AF3:AF" & lastrow_SHEETNAME1) = .Range("AF3:AF" & lastrow_SHEETNAME1).Value '.Range("AG3:AG" & lastrow_SHEETNAME1) = .Range("AG3:AG" & lastrow_SHEETNAME1).Value '.Range("AI3:AI" & lastrow_SHEETNAME1) = .Range("AI3:AI" & lastrow_SHEETNAME1).Value '.Range("AJ3:AJ" & lastrow_SHEETNAME1) = .Range("AJ3:AJ" & lastrow_SHEETNAME1).Value '.Range("AK3:AK" & lastrow_SHEETNAME1) = .Range("AK3:AK" & lastrow_SHEETNAME1).Value '.Range("AM3:AM" & lastrow_SHEETNAME1) = .Range("AM3:AM" & lastrow_SHEETNAME1).Value '.Range("AN3:AN" & lastrow_SHEETNAME1) = .Range("AN3:AN" & lastrow_SHEETNAME1).Value '.Range("AO3:AR" & lastrow_SHEETNAME1) = .Range("AO3:AR" & lastrow_SHEETNAME1).Value '.Range("AP3:AP" & lastrow_SHEETNAME1) = .Range("AP3:AP" & lastrow_SHEETNAME1).Value '.Range("AQ3:AQ" & lastrow_SHEETNAME1) = .Range("AQ3:AQ" & lastrow_SHEETNAME1).Value '.Range("AR3:AR" & lastrow_SHEETNAME1) = .Range("AR3:AR" & lastrow_SHEETNAME1).Value '.Range("AS3:AS" & lastrow_SHEETNAME1) = .Range("AS3:AS" & lastrow_SHEETNAME1).Value '.Range("AU3:AU" & lastrow_SHEETNAME1) = .Range("AU3:AU" & lastrow_SHEETNAME1).Value '.Range("AV3:AV" & lastrow_SHEETNAME1) = .Range("AV3:AV" & lastrow_SHEETNAME1).Value '.Range("AW3:AW" & lastrow_SHEETNAME1) = .Range("AW3:AW" & lastrow_SHEETNAME1).Value '.Range("AX3:AX" & lastrow_SHEETNAME1) = .Range("AX3:AX" & lastrow_SHEETNAME1).Value '.Range("BA3:BA" & lastrow_SHEETNAME1) = .Range("BA3:BA" & lastrow_SHEETNAME1).Value '.Range("BC3:BC" & lastrow_SHEETNAME1) = .Range("BC3:BC" & lastrow_SHEETNAME1).Value '.Range("BD3:BD" & lastrow_SHEETNAME1) = .Range("BD3:BD" & lastrow_SHEETNAME1).Value '.Range("BF3:BF" & lastrow_SHEETNAME1) = .Range("BF3:BF" & lastrow_SHEETNAME1).Value '.Range("BG3:BG" & lastrow_SHEETNAME1) = .Range("BG3:BG" & lastrow_SHEETNAME1).Value '.Range("BH3:BH" & lastrow_SHEETNAME1) = .Range("BH3:BH" & lastrow_SHEETNAME1).Value '.Range("BI3:BI" & lastrow_SHEETNAME1) = .Range("BI3:BI" & lastrow_SHEETNAME1).Value '.Range("BJ3:BJ" & lastrow_SHEETNAME1) = .Range("BJ3:BJ" & lastrow_SHEETNAME1).Value '.Range("BK3:BK" & lastrow_SHEETNAME1) = .Range("BK3:BK" & lastrow_SHEETNAME1).Value '.Range("BL3:BL" & lastrow_SHEETNAME1) = .Range("BL3:BL" & lastrow_SHEETNAME1).Value ' Select A1. ScrollTo ActiveSheet.name, "A1" End With End With End Sub ' Converts all formulae cells on the SHEETNAME1 sheet into values. ' Does not change row 2 of the SHEETNAME1 sheet. This retains the formulae in this row. ' This may run for a very long time. Go have a coffee. Sub M12030_Convert_SHEETNAME1_Formulae_to_Values() Dim lastrow_SHEETNAME1 As Long ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Convert SHEETNAME1 formulae to values?", vbYesNo) = vbNo Then Exit Sub End If With Workbooks(wb_name) With .Sheets("SHEETNAME1") ' Activate the sheet. .Activate ' Get how many rows of data have been loaded into the sheet. 'lastrow = Workbooks(my1042Rec).Sheets("SHEETNAME1").Range("D65536").End(xlUp).Row lastrow_SHEETNAME1 = .Cells(Rows.Count, 4).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_SHEETNAME1 < 3 Then lastrow_SHEETNAME1 = 3 End If ' Now copy and paste formula ranges as values to speed up the file processing. .Range("A3:A" & lastrow_SHEETNAME1) = .Range("A3:A" & lastrow_SHEETNAME1).Value .Range("B3:B" & lastrow_SHEETNAME1) = .Range("B3:B" & lastrow_SHEETNAME1).Value .Range("F3:F" & lastrow_SHEETNAME1) = .Range("F3:F" & lastrow_SHEETNAME1).Value .Range("H3:H" & lastrow_SHEETNAME1) = .Range("H3:H" & lastrow_SHEETNAME1).Value .Range("J3:J" & lastrow_SHEETNAME1) = .Range("J3:J" & lastrow_SHEETNAME1).Value .Range("L3:L" & lastrow_SHEETNAME1) = .Range("L3:L" & lastrow_SHEETNAME1).Value .Range("M3:M" & lastrow_SHEETNAME1) = .Range("M3:M" & lastrow_SHEETNAME1).Value .Range("T3:T" & lastrow_SHEETNAME1) = .Range("T3:T" & lastrow_SHEETNAME1).Value .Range("V3:V" & lastrow_SHEETNAME1) = .Range("V3:V" & lastrow_SHEETNAME1).Value .Range("W3:W" & lastrow_SHEETNAME1) = .Range("W3:W" & lastrow_SHEETNAME1).Value .Range("X3:X" & lastrow_SHEETNAME1) = .Range("X3:X" & lastrow_SHEETNAME1).Value .Range("AB3:AB" & lastrow_SHEETNAME1) = .Range("AB3:AB" & lastrow_SHEETNAME1).Value .Range("AC3:AC" & lastrow_SHEETNAME1) = .Range("AC3:AC" & lastrow_SHEETNAME1).Value .Range("AE3:AE" & lastrow_SHEETNAME1) = .Range("AE3:AE" & lastrow_SHEETNAME1).Value .Range("AG3:AG" & lastrow_SHEETNAME1) = .Range("AG3:AG" & lastrow_SHEETNAME1).Value .Range("AH3:AH" & lastrow_SHEETNAME1) = .Range("AH3:AH" & lastrow_SHEETNAME1).Value .Range("AJ3:AJ" & lastrow_SHEETNAME1) = .Range("AJ3:AJ" & lastrow_SHEETNAME1).Value .Range("AK3:AK" & lastrow_SHEETNAME1) = .Range("AK3:AK" & lastrow_SHEETNAME1).Value .Range("AL3:AL" & lastrow_SHEETNAME1) = .Range("AL3:AL" & lastrow_SHEETNAME1).Value .Range("AN3:AN" & lastrow_SHEETNAME1) = .Range("AN3:AN" & lastrow_SHEETNAME1).Value .Range("AO3:AO" & lastrow_SHEETNAME1) = .Range("AO3:AO" & lastrow_SHEETNAME1).Value .Range("AP3:AP" & lastrow_SHEETNAME1) = .Range("AP3:AP" & lastrow_SHEETNAME1).Value .Range("AQ3:AQ" & lastrow_SHEETNAME1) = .Range("AQ3:AQ" & lastrow_SHEETNAME1).Value .Range("AR3:AR" & lastrow_SHEETNAME1) = .Range("AR3:AR" & lastrow_SHEETNAME1).Value .Range("AS3:AS" & lastrow_SHEETNAME1) = .Range("AS3:AS" & lastrow_SHEETNAME1).Value .Range("AT3:AT" & lastrow_SHEETNAME1) = .Range("AT3:AT" & lastrow_SHEETNAME1).Value .Range("AV3:AV" & lastrow_SHEETNAME1) = .Range("AV3:AV" & lastrow_SHEETNAME1).Value .Range("AW3:AW" & lastrow_SHEETNAME1) = .Range("AW3:AW" & lastrow_SHEETNAME1).Value .Range("AX3:AX" & lastrow_SHEETNAME1) = .Range("AX3:AX" & lastrow_SHEETNAME1).Value .Range("AY3:AY" & lastrow_SHEETNAME1) = .Range("AY3:AY" & lastrow_SHEETNAME1).Value .Range("BB3:BB" & lastrow_SHEETNAME1) = .Range("BB3:BB" & lastrow_SHEETNAME1).Value .Range("BD3:BD" & lastrow_SHEETNAME1) = .Range("BD3:BD" & lastrow_SHEETNAME1).Value .Range("BE3:BE" & lastrow_SHEETNAME1) = .Range("BE3:BE" & lastrow_SHEETNAME1).Value .Range("BG3:BG" & lastrow_SHEETNAME1) = .Range("BG3:BG" & lastrow_SHEETNAME1).Value .Range("BH3:BH" & lastrow_SHEETNAME1) = .Range("BH3:BH" & lastrow_SHEETNAME1).Value .Range("BI3:BI" & lastrow_SHEETNAME1) = .Range("BI3:BI" & lastrow_SHEETNAME1).Value .Range("BJ3:BJ" & lastrow_SHEETNAME1) = .Range("BJ3:BJ" & lastrow_SHEETNAME1).Value .Range("BK3:BK" & lastrow_SHEETNAME1) = .Range("BK3:BK" & lastrow_SHEETNAME1).Value .Range("BL3:BL" & lastrow_SHEETNAME1) = .Range("BL3:BL" & lastrow_SHEETNAME1).Value .Range("BM3:BM" & lastrow_SHEETNAME1) = .Range("BM3:BM" & lastrow_SHEETNAME1).Value ' Select A1. ScrollTo ActiveSheet.name, "A1" End With End With End Sub ' Imports the Wxxxx file. Sub M13000_Import_Wxxxx() Dim fileToOpen As Variant Dim count_Wxxxx As Double Dim count_InputFile As Double Dim lastrow_Wxxxx As Long Dim lastrow_InputFile As Long Dim my_from_column As Variant Dim my_to_column As Variant Dim fileToOpen_name As String Dim FileParts() As String ' Initialize global vars. Call Z00000_Init ' Ask user. If ctrl_ask_before_running_subroutine = True Then If MsgBox("Import Wxxxx?", vbYesNo) = vbNo Then Exit Sub End If With Workbooks(wb_name) ' First clears out existing Wxxxx sheet, besides row 2 which is kept as it contains formulae. With .Sheets("Wxxxx") ' Activates the sheet. .Activate ' Get how many rows of data have been loaded into the sheet. lastrow_Wxxxx = .Cells(Rows.Count, 2).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_Wxxxx < 2 Then lastrow_Wxxxx = 2 End If ' Clear entire Wxxxx sheet, except for columns Y & Z which contains formulae. DeleteUnusedOnSheet ("Wxxxx") .Range("A2:Z" & lastrow_Wxxxx).ClearContents .Range("A2:Z" & lastrow_Wxxxx).Delete ' Control to confirm there is currently no data in the sheet. If WorksheetFunction.CountA(.Range("A2:Z" & lastrow_Wxxxx)) Then MsgBox "There is data still present in the Wxxxx sheet, these should be blank. Ensure they are empty before running this process" Exit Sub End If End With End With ' Ask user for a Wxxxx file to load. fileToOpen = Application.GetOpenFilename("Excel files (*.xls; *.xlsx; *.csv),*.xls; *.xlsx; *.csv", , "Select Wxxxx file") If fileToOpen = False Then MsgBox "No Wxxxx file selected. No data copied across to the Wxxxx sheet." Exit Sub End If FileParts() = Split(fileToOpen, Application.PathSeparator) fileToOpen_name = FileParts(UBound(FileParts)) ' Start of copying columns across. With Workbooks.Open(fileToOpen) With .Sheets(1) ' Activate the workbook. .Activate ' Control to check that the Wxxxx file is in the usual format. ' If .Range("A2") Like "???????" Then ' Else ' If ctrl_close_erroneous_files = True Then ' Close the file. ' Application.DisplayAlerts = False ' Workbooks(fileToOpen_name).Close ' Application.DisplayAlerts = True ' End If ' MsgBox "The Wxxxx file is not in the usual format, it may have been change since the code was written, please follow the procedure to manually copy the columns across." ' Exit Sub ' End If ' Control to check that the Wxxxx file is in the usual format. If WorksheetFunction.CountA(.Range("A1:X1")) = 24 Then Else If ctrl_close_erroneous_files = True Then ' Close the file. Application.DisplayAlerts = False Workbooks(fileToOpen_name).Close Application.DisplayAlerts = True End If MsgBox "The Wxxxx file is not in the usual format, it may have been change since the code was written, please follow the procedure to manually copy the columns across" Exit Sub End If ' Determine how many rows in the input file. lastrow_InputFile = .Cells(Rows.Count, 2).End(xlUp).Row ' MsgBox ActiveWorkbook.Sheets(1).Name ' Copy all columns from Wxxxx file into master sheet where column names match. For Each my_from_column In .Range("A1:X1") ' Range is all columns in Wxxxx file. For Each my_to_column In Workbooks(wb_name).Sheets("Wxxxx").Range("A1:X1") ' X is last column containing data from Wxxxx file. If my_from_column = my_to_column Then .Range(Cells(2, my_from_column.Column), Cells(lastrow_InputFile + 1, my_from_column.Column).End(xlUp)).Copy Workbooks(wb_name).Sheets("Wxxxx").Cells(2, my_to_column.Column) End If Next my_to_column Next my_from_column ' Counts the number of cells from the input file that should have been copied across. count_InputFile = WorksheetFunction.CountA(.Range("A2:X" & lastrow_InputFile)) End With ' Close the file. Application.DisplayAlerts = False .Close Application.DisplayAlerts = True End With ' Counts the number of cells in the Wxxxx sheet that have been copied across. With Workbooks(wb_name) ' Activate the workbook. .Activate With .Sheets("Wxxxx") ' Activate the sheet. .Activate ' Get how many rows of data have been loaded into the sheet. lastrow_Wxxxx = .Cells(Rows.Count, 2).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_Wxxxx < 2 Then lastrow_Wxxxx = 2 End If ' Count how much data has been loaded into the Wxxxx sheet. count_Wxxxx = WorksheetFunction.CountA(.Range("A2:X" & lastrow_Wxxxx)) ' Select A1. ScrollTo ActiveSheet.name, "A1" End With End With ' Control to ensure that the number of cells copied across matches those in the originating file. If count_Wxxxx <> count_InputFile Then MsgBox "The number of cells copied from the Wxxxx file does not equal the number of cells copied to the 1042 rec. Please manually copy them across." Exit Sub End If ' Add in formulae and sort the Wxxxx sheet. With Workbooks(wb_name) With .Sheets("Wxxxx") ' Activates the sheet. .Activate ' Determine the number of rows. lastrow_Wxxxx = .Cells(Rows.Count, 2).End(xlUp).Row ' Prevent line 2 being deleted - as this contains the formulae which need coping down later. If lastrow_Wxxxx < 2 Then lastrow_Wxxxx = 2 End If ' Resets formulae on "Wxxxx". .Range("Y2").Formula = "=IF(AND(YEAR(T2)>=YEAR(NOW()), YEAR(T2)-YEAR(S2)<=3),IF(TRIM(C2)<>"""",IF(E2=TRUE,IF(G2=TRUE,IF(TRIM(K2)<>""All Other Countries"",IF(O2=TRUE,IF(P2=TRUE,IF(Q2=TRUE,IF(X2=FALSE,""YES"",""NO1""),""NO2""),""NO3""),""NO4""),""NO5""),""NO6""),""NO7""),""NO8""),""NO9"")" .Range("Z2").Formula = "=IF(Y2=""YES"",IFERROR(VLOOKUP(K2,References!AI:AJ,2,FALSE),30),30)" .Range("Y2:Z2").AutoFill Destination:=.Range("Y2:Z" & lastrow_Wxxxx) .Range("Y3:Z" & lastrow_Wxxxx) = .Range("Y3:Z" & lastrow_Wxxxx).Value ' Do the sort. With .Sort '.AutoFilter With .SortFields .Clear .Add Key:=Range("B1:B" & lastrow_Wxxxx), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal End With .SetRange Range("A1:Z" & lastrow_Wxxxx) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With ' Select A1. ScrollTo ActiveSheet.name, "A1" End With End With ' Clear all objects. Set my_from_column = Nothing Set my_to_column = Nothing End Sub
microsoft_excel/macros/macro_full_example_program.txt · Last modified: 2021/08/04 13:59 by peter