User Tools

Site Tools


microsoft_excel:macros:copy:copy_formulae_down_on_a_sheet_using_arrays

Microsoft Excel - Macros - Copy - Copy formulae down on a sheet using arrays

' Copy formula on the Sheet1 sheet down for all populated rows.
' Speeds this up using Arrays
Sub Copy_Formulae_Down_Array()
 
    Dim mycell As Variant
    Dim lastrow_Sheet2 As Long
    Dim lastrow_Sheet1 As Long
 
    Dim working As Variant
    Dim column_a_Sheet1 As Variant
    Dim column_d_Sheet1 As Variant
    Dim column_k_Sheet1 As Variant
    Dim column_l_Sheet1 As Variant
    Dim column_n_Sheet1 As Variant
    Dim column_o_Sheet1 As Variant
    Dim column_p_Sheet1 As Variant
    Dim column_r_Sheet1 As Variant
    Dim column_s_Sheet1 As Variant
    Dim column_ae_Sheet1 As Variant
    Dim column_ak_Sheet1 As Variant
    Dim column_al_Sheet1 As Variant
 
    Dim column_a_Sheet2 As Variant
    Dim column_f_Sheet2 As Variant
    Dim column_g_Sheet2 As Variant
    Dim column_i_Sheet2 As Variant
    Dim column_j_Sheet2 As Variant
    Dim column_ao_Sheet2 As Variant
 
    Dim n As Long
 
 
    ' Ask user.
    If ctrl_ask_before_running_subroutine = True Then
        If MsgBox("Copy post Sheet1 formulae down?", vbYesNo) = vbNo Then Exit Sub
    End If
 
 
    ' Update StatusBar.
    Application.StatusBar = "Copy post-Sheet1 Formulae down..."
 
 
    With Workbooks(wb_name)
 
        ' Get how many rows of data have been loaded into the sheet.
        lastrow_Sheet2 = Sheets("Sheet2").Cells(Rows.Count, 4).End(xlUp).Row
        ' Prevent line 2 being deleted - as this contains the formulae which need coping down later.
        If lastrow_Sheet2 < 3 Then
            lastrow_Sheet2 = 3
        End If
 
 
        With .Sheets("Sheet1")
 
            ' Activate the sheet.
            .Activate
 
            ' Get how many rows of data have been loaded into the sheet.
            lastrow_Sheet1 = .Cells(Rows.Count, 4).End(xlUp).Row
            ' Prevent line 2 being deleted - as this contains the formulae which need coping down later.
            If lastrow_Sheet1 < 3 Then
                lastrow_Sheet1 = 3
            End If
 
            ReDim working(1 To lastrow_Sheet1, 1) ' Working array
            working = Range("D3:D" & lastrow_Sheet1) ' load with dummy values.
 
            ReDim column_a_Sheet1(1 To lastrow_Sheet1, 1)
            ReDim column_k_Sheet1(1 To lastrow_Sheet1, 1)
            ReDim column_l_Sheet1(1 To lastrow_Sheet1, 1)
            ReDim column_n_Sheet1(1 To lastrow_Sheet1, 1)
            ReDim column_o_Sheet1(1 To lastrow_Sheet1, 1)
            ReDim column_p_Sheet1(1 To lastrow_Sheet1, 1)
            ReDim column_r_Sheet1(1 To lastrow_Sheet1, 1)
            ReDim column_s_Sheet1(1 To lastrow_Sheet1, 1)
            ReDim column_ae_Sheet1(1 To lastrow_Sheet1, 1)
            ReDim column_ak_Sheet1(1 To lastrow_Sheet1, 1)
            ReDim column_al_Sheet1(1 To lastrow_Sheet1, 1)
 
            ReDim column_a_Sheet2(1 To lastrow_Sheet2, 1)
            ReDim column_f_Sheet2(1 To lastrow_Sheet2, 1)
            ReDim column_g_Sheet2(1 To lastrow_Sheet2, 1)
            ReDim column_i_Sheet2(1 To lastrow_Sheet2, 1)
            ReDim column_j_Sheet2(1 To lastrow_Sheet2, 1)
            ReDim column_ao_Sheet2(1 To lastrow_Sheet2, 1)
 
 
            ' Column AE
            ' FX_Rate
            working = Range("AE3:AE" & lastrow_Sheet1)
            column_ae_Sheet1 = Range("AE3:AE" & lastrow_Sheet1)
            For n = LBound(working) To UBound(working)
              If Not column_ae_Sheet1(n, 1) Like "*[0-9]*" Then
                working(n, 1) = 1
              End If
            Next n
 
            .Range("AE3:AE" & lastrow_Sheet1).Value = working
 
 
 
 
            ' Column P - needed before column N
            ' =IF(R2="",K2*S2/100,K2*R2/100)
            column_r_Sheet1 = Range("R3:R" & lastrow_Sheet1)
            column_k_Sheet1 = Range("O3:O" & lastrow_Sheet1)
            column_s_Sheet1 = Range("S3:S" & lastrow_Sheet1)
            For n = LBound(working) To UBound(working)
                If column_r_Sheet1(n, 1) = "" Then
                    working(n, 1) = column_k_Sheet1(n, 1) * column_s_Sheet1(n, 1) / 100
                Else
                    working(n, 1) = column_k_Sheet1(n, 1) * column_r_Sheet1(n, 1) / 100
                End If
            Next n
 
            .Range("P3:P" & lastrow_Sheet1).Value = working
 
 
            ' Column N - needed before column M
            ' =P2*AE2
            column_p_Sheet1 = Range("P3:P" & lastrow_Sheet1)
            column_ae_Sheet1 = Range("AE3:AE" & lastrow_Sheet1)
            For n = LBound(working) To UBound(working)
                working(n, 1) = column_p_Sheet1(n, 1) * column_ae_Sheet1(n, 1)
            Next n
 
            .Range("N3:N" & lastrow_Sheet1).Value = working
 
 
            ' Column M
            '=L2-N2
            column_l_Sheet1 = Range("L3:L" & lastrow_Sheet1)
            column_n_Sheet1 = Range("N3:N" & lastrow_Sheet1)
            For n = LBound(working) To UBound(working)
                working(n, 1) = column_l_Sheet1(n, 1) - column_n_Sheet1(n, 1)
            Next n
 
            .Range("M3:M" & lastrow_Sheet1).Value = working
 
 
 
            ' Column Q
            ' =IF(R2="",S2*100,R2*100)
            column_r_Sheet1 = Range("R3:R" & lastrow_Sheet1)
            column_s_Sheet1 = Range("S3:S" & lastrow_Sheet1)
            For n = LBound(working) To UBound(working)
                If column_r_Sheet1(n, 1) = "" Then
                    working(n, 1) = column_s_Sheet1(n, 1) * 100
                Else
                    working(n, 1) = column_r_Sheet1(n, 1) * 100
                End If
            Next n
 
            .Range("Q3:Q" & lastrow_Sheet1).Value = working
 
 
 
            ' Column AI
            ' =IF(ISNA(VLOOKUP(D2,Sheet2!G$1:G$52435,1,FALSE)),"NOT FOUND","FOUND")
            column_d_Sheet1 = Range("D3:D" & lastrow_Sheet1)
            column_g_Sheet2 = Range("G3:G" & lastrow_Sheet2)
            For n = LBound(working) To UBound(working)
                working(n, 1) = ArrayFindEx(column_g_Sheet2, column_d_Sheet1(n, 1), "FOUND", "NOT FOUND")
            Next n
 
            .Range("AI3:AI" & lastrow_Sheet1).Value = working
 
 
 
            ' Column AJ
            'D2=D1
            .Range("AJ2:AJ2").AutoFill Destination:=.Range("AJ2:AJ" & lastrow_Sheet1)
 
 
            ' Column AK
            ' =IF(COUNTIF($A$1:A2,A2)>1,"AGGREGATE",SUMIF($A$1:$A$2227,A2,$L$1:$L$2227)-SUMIF(Sheet2!$A$1:$A$52435,A2,Sheet2!$F$1:$F$52435))
            column_a_Sheet1 = Range("A3:A" & lastrow_Sheet1)
            column_l_Sheet1 = Range("L3:L" & lastrow_Sheet1)
            column_a_Sheet2 = Sheets("Sheet2").Range("A3:A" & lastrow_Sheet2)
            column_f_Sheet2 = Sheets("Sheet2").Range("F3:F" & lastrow_Sheet2)
            For n = LBound(working) To UBound(working)
 
                If ArrayCountIf(column_a_Sheet1, column_a_Sheet1(n, 1)) > 1 Then
                    working(n, 1) = "AGGREGATE"
                Else
                    working(n, 1) = ArraySumIf(column_a_Sheet1, column_a_Sheet1(n, 1), column_l_Sheet1) - ArraySumIf(column_a_Sheet2, column_a_Sheet1(n, 1), column_f_Sheet2)
                End If
            Next n
 
            .Range("AK3:AK" & lastrow_Sheet1).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_Sheet1 = Range("A3:A" & lastrow_Sheet1)
'            column_aj_Sheet1 = Range("AJ3:AJ" & lastrow_Sheet1)
'            column_ai_Sheet1 = Range("AI3:AJ" & lastrow_Sheet1)
'            For n = LBound(working) To UBound(working)
'                If column_a_Sheet1(n, 1) = column_a_Sheet1(n - 1, 1) Then
'                    working(n, 1) = column_aj_Sheet1(n - 1, 1)
'                Else
'                    If column_ai_Sheet1(n, 1) > -0.1 And column_ai_Sheet1(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_Sheet1).Value = working
 
 
            .Range("AL2").AutoFill Destination:=.Range("AL2:AL" & lastrow_Sheet1)
            .Range("AL2:AL" & lastrow_Sheet1).Calculate
            .Range("AL3:AL" & lastrow_Sheet1) = .Range("AL3:AL" & lastrow_Sheet1).Value
 
 
 
            ' Column AM
            ' =IF(COUNTIF($A$1:A2,A2)>1,"AGGREGATE",SUMIF($A$1:$A$2227,A2,$K$1:$K$2227)-SUMIF(Sheet2!$A$1:A$52435,A2,Sheet2!$AO$1:$AO$52435))
            column_a_Sheet1 = Range("A3:A" & lastrow_Sheet1)
            column_k_Sheet1 = Range("K3:K" & lastrow_Sheet1)
            column_a_Sheet2 = Sheets("Sheet2").Range("A3:A" & lastrow_Sheet2)
            column_ao_Sheet2 = Sheets("Sheet2").Range("AO3:AO" & lastrow_Sheet2)
            For n = LBound(working) To UBound(working)
 
                If ArrayCountIf(column_a_Sheet1, column_a_Sheet1(n, 1)) > 1 Then
                    working(n, 1) = "AGGREGATE"
                Else
                    working(n, 1) = ArraySumIf(column_a_Sheet1, column_a_Sheet1(n, 1), column_k_Sheet1) - ArraySumIf(column_a_Sheet2, column_a_Sheet1(n, 1), column_ao_Sheet2)
                End If
            Next n
 
            .Range("AM3:AM" & lastrow_Sheet1).Value = working
 
 
 
            ' Column AR
            ' =IF(COUNTIF($A$1:A2,A2)>1,"AGGREGATE",SUMIF($A$1:$A$2227,A2,$P$1:$P$2227)-SUMIF(Sheet2!$A$1:$A$52435,A2,Sheet2!$J$1:$J$52435))
            column_a_Sheet1 = Range("A3:A" & lastrow_Sheet1)
            column_p_Sheet1 = Range("P3:P" & lastrow_Sheet1)
            column_a_Sheet2 = Sheets("Sheet2").Range("A3:A" & lastrow_Sheet2)
            column_j_Sheet2 = Sheets("Sheet2").Range("J3:J" & lastrow_Sheet2)
            For n = LBound(working) To UBound(working)
 
                If ArrayCountIf(column_a_Sheet1, column_a_Sheet1(n, 1)) > 1 Then
                    working(n, 1) = "AGGREGATE"
                Else
                    working(n, 1) = ArraySumIf(column_a_Sheet1, column_a_Sheet1(n, 1), column_p_Sheet1) - ArraySumIf(column_a_Sheet2, column_a_Sheet1(n, 1), column_j_Sheet2)
                End If
            Next n
 
            .Range("AR3:AR" & lastrow_Sheet1).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_Sheet1 = Range("A3:A" & lastrow_Sheet1)
'            column_aq_Sheet1 = Range("AQ3:AQ" & lastrow_Sheet1)
'            column_ap_Sheet1 = Range("AP3:AP" & lastrow_Sheet1)
'            For n = LBound(working) To UBound(working)
'                If column_a_Sheet1(n, 1) = column_a_Sheet1(n - 1, 1) Then
'                    working(n, 1) = column_aq_Sheet1(n - 1, 1)
'                Else
'                    If column_ap_Sheet1(n, 1) > -0.1 And column_ap_Sheet1(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_Sheet1).Value = working
 
 
            .Range("AS2").AutoFill Destination:=.Range("AS2:AS" & lastrow_Sheet1)
            .Range("AS2:AS" & lastrow_Sheet1).Calculate
            .Range("AS3:AS" & lastrow_Sheet1) = .Range("AS3:AS" & lastrow_Sheet1).Value
 
 
 
            ' Column AT
            ' =IF(COUNTIF($A$1:A2,A2)>1,"AGGREGATE",SUMIF($A$1:$A$2227,A2,$O$1:$O$2227)-SUMIF(Sheet2!$A$1:$A$52435,A2,Sheet2!$I$1:$I$52435))
            column_a_Sheet1 = Range("A3:A" & lastrow_Sheet1)
            column_o_Sheet1 = Range("O3:O" & lastrow_Sheet1)
            column_a_Sheet2 = Sheets("Sheet2").Range("A3:A" & lastrow_Sheet2)
            column_i_Sheet2 = Sheets("Sheet2").Range("I3:I" & lastrow_Sheet2)
            For n = LBound(working) To UBound(working)
 
                If ArrayCountIf(column_a_Sheet1, column_a_Sheet1(n, 1)) > 1 Then
                    working(n, 1) = "AGGREGATE"
                Else
                    working(n, 1) = ArraySumIf(column_a_Sheet1, column_a_Sheet1(n, 1), column_o_Sheet1) - ArraySumIf(column_a_Sheet2, column_a_Sheet1(n, 1), column_i_Sheet2)
                End If
            Next n
 
            .Range("AT3:AT" & lastrow_Sheet1).Value = working
 
        End With
    End With
 
 
    ' Clear all objects.
    Set mycell = Nothing
 
    Set working = Nothing
 
    Set column_a_Sheet1 = Nothing
    Set column_d_Sheet1 = Nothing
    Set column_k_Sheet1 = Nothing
    Set column_l_Sheet1 = Nothing
    Set column_n_Sheet1 = Nothing
    Set column_o_Sheet1 = Nothing
    Set column_p_Sheet1 = Nothing
    Set column_r_Sheet1 = Nothing
    Set column_s_Sheet1 = Nothing
    Set column_ae_Sheet1 = Nothing
    Set column_ak_Sheet1 = Nothing
    Set column_al_Sheet1 = Nothing
 
    Set column_a_Sheet2 = Nothing
    Set column_f_Sheet2 = Nothing
    Set column_i_Sheet2 = Nothing
    Set column_j_Sheet2 = Nothing
    Set column_ao_Sheet2 = Nothing
 
End Sub
microsoft_excel/macros/copy/copy_formulae_down_on_a_sheet_using_arrays.txt · Last modified: 2021/08/04 15:08 by peter

Donate Powered by PHP Valid HTML5 Valid CSS Driven by DokuWiki