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? 
Need Macros to replace the Formula. Please Help if you can.

VbaNoExcel 
July 12, 2021 at 8:20 PM 
Thread is marked as Resolved.
We will be implementing some important changes during 25th and 26th May 2024 which may result in an outage period of the website. We anticipate this process may take a couple of hours and so we apologise in advance for any inconvenience.



This macro will replace the formulas in columns A and AT of the Data sheet:
Code
Display MoreSub 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) = "NonLabour" End If Next i End With End With With desWS.Range("AT7", desWS.Range("AT" & Rows.Count).End(xlUp)) .Formula = "=AG7G7" .Value = .Value End With Application.ScreenUpdating = True End Sub
This macro will add all the data to the Output sheet including replacing the formulas:
Code
Display MoreSub 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) = "NonLabour" 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

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).

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.

Place this macro in a regular module not the ThisWorkbook code module.
Code
Display MoreSub 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) = "NonLabour" 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 = "=AH5H5" .Range("AU5:AU" & lRow).Value = .Range("AU5:AU" & lRow).Value End With Application.ScreenUpdating = True End Sub


hi mumps, many thanks for your kind help

You are very welcome.
Participate now!
Don’t have an account yet? Register yourself now and be a part of our community!