Need Macros to replace the Formula. Please Help if you can.

VbaNoExcel · Jul 12th 2021

hello good people
i have attached my file here. currently i am pulling data in "File_1.xlsx" (file attached) tab named "Output" tab by formula but as i add more data, i can see that the file will become larger and slower. therefore, wondering if you folks could help me to automate by writing macros to pull data into "OUTPUT" tab from "Data" tab (you can see how i pulling data with Sumproduct formula) . My request is below:

I need a Macro that will do exactly what I am doing with the "SUMPRODUCT" formula from cell F5 to AU9 in the "OUTPUT" tab.

I need to have the flexibility of adding/ deleting more rows or columns as I add/ delete more/ some rows for "Cost_Centre", "Accounts", "Business_Line".

Is it possible to automate the formula in this Column B?

Mumps · Jul 13th 2021

This macro will replace the formulas in columns A and AT of the Data sheet:

Code

Sub Category()
    Application.ScreenUpdating = False
    Dim v As Variant, i As Long, x As Long, desWS As Worksheet
    Set desWS = Sheets("Data")
    v = desWS.Range("C7", desWS.Range("C" & Rows.Count).End(xlUp)).Value
    With CreateObject("scripting.dictionary")
        With desWS
            For i = 1 To UBound(v)
                 If Mid(v(i, 1), 4, 4) < 6000 Then
                     .Range("A" & i + 6) = "Labour"
                 Else
                     .Range("A" & i + 6) = "Non-Labour"
                 End If
            Next i
        End With
    End With
    With desWS.Range("AT7", desWS.Range("AT" & Rows.Count).End(xlUp))
        .Formula = "=AG7-G7"
        .Value = .Value
    End With
    Application.ScreenUpdating = True
End Sub

Display More

This macro will add all the data to the Output sheet including replacing the formulas:

Code

Sub CreateOutput()
    Application.ScreenUpdating = False
    Dim v1 As Variant, v2 As Variant, i As Long, x As Long, srcWS As Worksheet, desWS As Worksheet, val As String, fnd As Range, dic As Object
    Set srcWS = Sheets("Data")
    Set desWS = Sheets("Output")
    v1 = srcWS.Range("A7", srcWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 46).Value
    v2 = desWS.Range("C4", desWS.Range("C" & Rows.Count).End(xlUp)).Resize(, 45).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(v2)
        If Mid(v2(i, 2), 4, 4) < 6000 Then
            desWS.Range("B" & i + 3) = "Labour"
        Else
            desWS.Range("B" & i + 3) = "Non-Labour"
        End If
    Next i
    For i = 1 To UBound(v1)
        val = v1(i, 1) & "|" & v1(i, 2) & "|" & v1(i, 3) & "|" & v1(i, 4)
        If Not dic.exists(val) Then
            dic.Add val, i + 6
        End If
    Next i
    v2 = desWS.Range("B4", desWS.Range("C" & Rows.Count).End(xlUp)).Resize(, 46).Value
    For i = 2 To UBound(v2)
        val = v2(i, 1) & "|" & v2(i, 2) & "|" & v2(i, 3) & "|" & v2(i, 4)
        If dic.exists(val) Then
            For x = 5 To UBound(v2, 2)
                Set fnd = srcWS.Rows(6).Find(v2(1, x))
                desWS.Cells(i + 3, x + 1) = srcWS.Cells(dic(val), fnd.Column)
            Next x
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

Display More

VbaNoExcel · Jul 13th 2021

hi mumps

many thanks for your kind help. Working like a charm. one small thing.............In my effort to reduce some repeat commands, i realized that the formula/ macro for Column A and AT in "data" tab can just be in Column B and Column AU of "output" tab. is there any way to incorporate this change in the 2nd Macros that you sent? (this way i will not need the 1st macros and just one macro will deliver everything neatly).

VbaNoExcel · Jul 13th 2021

hey mumps, here is the file again. i got rid of the column A and Column AT in "data" tab and attached the new look file here for your convenience.

Mumps · Jul 14th 2021

Place this macro in a regular module not the ThisWorkbook code module.

Code

Sub CreateOutput()
    Application.ScreenUpdating = False
    Dim v1 As Variant, v2 As Variant, val As String, fnd As Range, dic As Object
    Dim i As Long, x As Long, srcWS As Worksheet, desWS As Worksheet, lRow As Long
    Set srcWS = Sheets("Data")
    Set desWS = Sheets("Output")
    v1 = srcWS.Range("A7", srcWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 44).Value
    v2 = desWS.Range("C4", desWS.Range("C" & Rows.Count).End(xlUp)).Resize(, 44).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(v2)
        If Mid(v2(i, 2), 4, 4) < 6000 Then
            desWS.Range("B" & i + 3) = "Labour"
        Else
            desWS.Range("B" & i + 3) = "Non-Labour"
        End If
    Next i
    For i = 1 To UBound(v1)
        val = v1(i, 1) & "|" & v1(i, 2) & "|" & v1(i, 3)
        If Not dic.exists(val) Then
            dic.Add val, i + 6
        End If
    Next i
    v2 = desWS.Range("C4", desWS.Range("C" & Rows.Count).End(xlUp)).Resize(, 44).Value
    For i = 2 To UBound(v2)
        val = v2(i, 1) & "|" & v2(i, 2) & "|" & v2(i, 3)
        If dic.exists(val) Then
            For x = 4 To UBound(v2, 2)
                Set fnd = srcWS.Rows(6).Find(v2(1, x))
                desWS.Cells(i + 3, x + 2) = srcWS.Cells(dic(val), fnd.Column)
            Next x
        End If
    Next i
    With desWS
        lRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        .Range("AU5:AU" & lRow).Formula = "=AH5-H5"
        .Range("AU5:AU" & lRow).Value = .Range("AU5:AU" & lRow).Value
    End With
    Application.ScreenUpdating = True
End Sub

Display More

VbaNoExcel · Jul 15th 2021

hi mumps, many thanks for your kind help

Mumps · Jul 16th 2021

You are very welcome.

Need Macros to replace the Formula. Please Help if you can.

Participate now!

Share

Users Viewing This Thread