I'm looking for help for a macro that can replace formulas that make my Excel file huge

[K0st4din]

Hi everyone I have a great excel workbook.
In the Cardio worksheet, I have formulas in several columns that take information from other columns and arrive at the desired end result.
My problem is that I don't know how to turn all this information that I do by hand into a macro that does it.
I will attach a sample table with an explanation and I hope it will be understandable. As if there are unclear things, I will cooperate.
In column B2:B, I have names, in column D2:D I have dates, in column J2:J, I have abbreviations, in column P2:P I have values of numbers with a plus sign (+) - >>> of all - described above, I take all the information to reach the following rows and columns, which are as follows: In cell AD1 -> start date, in cell AE1 - end desired date. In column AF2: I start listing each name in column B2:B (and the order is according to the number of codes in column AT2: to the end (how many), (as in the example BAY BOY KIL - 19 times, and so on for each subsequent name).
In column AG2: to the end I have a formula that gives me a result based on the formulas in column GA2:GZ2.
In column AI2: to the end I have a formula that gives me a result based on the formulas in column HB2:IA2.
The results I send in the example are 100% correct. But since I have to copy each name every month, then paste the exact number of codes, then put the formulas in the back columns and rows, and then my file becomes mega huge, a copy / paste special values so that the file can become much smaller again, and range GA2:GZ2, HB2:IA2 delete it completely to remove formulas and calculations to significantly reduce file size
At least I found this solution to get the right result, you may find it much easier.
So my idea is, can someone convert all these formulas to replace them with a macro to make my job easier.
Because the explanation is very long, I remain available to help if something is unclear.

test repeat name codes and total.xlsm

I apologize a lot, but with the proposed option to attach the sample table, it does not allow me, because the cells are more than 300 and I can only send you a link to google drive to download and view it.

 

[K0st4din]

Hi, Yes, both macros and the first and second macros work. In each post I answer that I have tried them and I admit what remains to be done. In one sentence, the macro works at 80%. I wrote what he has left to be 100% working, in post number # 6. I can't mark something that has been decided since it is not 100%. Otherwise, I will lie to every other user. I remain available and thank you again for what you have done, which I appreciate endlessly!

 

[K0st4din]

My post #7
We should now clear or tell the macro to start looking for the names and after checking how much they are to take each name from column B2: to the end (according to the rows which are) and for each name to order the codes from column AT (which at the moment there are 19 (They can be 3, they can be 50).
From line 40-41AG and AI (up to 214 - in the example, I don't need these zeros because I have nothing to calculate) down it shows me 0 because I don't have Names in the AF column.
Or in other words: just an example: If I have 3 names, the following should be obtained: 1st name x 19 codes, 2nd name x 19 codes, 3rd name x 19 codes and when there are no more names down there should be no more 0 (zeros) ) -> AG and AI.

The two previous macros work, in this post #7, I wrote what it lacks to say that 100000% everything works and I can say that it is solved and thank you.
I don't know how to write it to make it clearer.

 

[DanteAmor]

At last I understood what you mean by the values of column AT and the (unique) values of column "B" ?, I needed the weekend and a couple of beers ?

---
Note: if you don't need the results in the "GA" to "HE" columns, then you can delete these lines, that way your sheet will be smaller and the macro will be faster.

  Range("HB2").Resize(UBound(c, 1), UBound(c, 2)).Value = c
  Range("AF2").Resize(n, 4).Value = bt

The macro does not need these values in the cells, the formulas do need them in the cells, but the macro performs all calculations in memory.
---

Try the following macro, I think it now contains all your requirements.

Sub Replace_Formulas()
  Dim a As Variant, b As Variant, c As Variant
  Dim bb As Variant, at As Variant, bt As Variant, x As Variant, y As Variant
  Dim i As Long, j As Long, k As Long, m As Long, n As Long, lrb As Long, lrt As Long
  Dim dicGA As Object, dicJF As Object, dicBB As Object
  Dim dt1 As Date, dt2 As Date
  Dim ky1 As String, ky2 As String, cad As String
  
  If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
  Set dicGA = CreateObject("Scripting.Dictionary")
  Set dicJF = CreateObject("Scripting.Dictionary")
  Set dicBB = CreateObject("Scripting.Dictionary")
  dt1 = Range("AD1").Value  'date ini
  dt2 = Range("AE1").Value  'date fin
  
  'for each name to order the codes from column AT
  lrb = Range("B" & Rows.Count).End(3).Row
  lrt = Range("AT" & Rows.Count).End(3).Row
  bb = Range("B2:B" & lrb)
  at = Range("AT2:AT" & lrt)
  ReDim bt(1 To UBound(bb, 1) * UBound(at, 1), 1 To 4)
  For i = 1 To UBound(bb, 1)
    If Not dicBB.exists(bb(i, 1)) Then
      dicBB(bb(i, 1)) = Empty
      For j = 1 To UBound(at, 1)
        n = n + 1
        bt(n, 1) = bb(i, 1)
        bt(n, 3) = at(j, 1)
      Next
    End If
  Next
  
  a = Range("A2:AH" & lrb).Value
  ReDim b(1 To UBound(a, 1), 1 To 26)
  ReDim c(1 To UBound(a, 1), 1 To 26)
  
  For i = 1 To UBound(a, 1)
    j = 0
    cad = ""
    For Each x In Split(a(i, 10), "+")    'column J
      j = j + 1
      b(i, j) = x
    
      'CountIfs
      If a(i, 4) >= dt1 And a(i, 4) <= dt2 Then
        If InStr(1, cad, x, vbTextCompare) = 0 Then
          ky2 = a(i, 2) & "|" & x
          dicJF(ky2) = dicJF(ky2) + 1
        End If
        cad = cad & x
      End If
    Next
    
    k = 0
    For Each y In Split(a(i, 16), "+")    'column P
      k = k + 1
      c(i, k) = y
      
      'SumProduct
      If a(i, 4) >= dt1 And a(i, 4) <= dt2 Then
        ky1 = a(i, 2) & "|" & b(i, k)
        dicGA(ky1) = dicGA(ky1) + Val(y)
      End If
    Next
  Next
  
  For i = 1 To n 'UBound(a, 1)
    ky1 = a(i, 32) & "|" & a(i, 34)   'column AF | AH
    'SumProduct
    If dicGA.exists(ky1) Then bt(i, 2) = dicGA(ky1) Else bt(i, 2) = 0
    'CountIfs
    If dicJF.exists(ky1) Then bt(i, 4) = dicJF(ky1) Else bt(i, 4) = 0
  Next
  Range("GA2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
  Range("HB2").Resize(UBound(c, 1), UBound(c, 2)).Value = c
  Range("AF2").Resize(n, 4).Value = bt
End Sub

 

[DanteAmor]

if you don't need the results in the "GA" to "HE" columns, then you can delete these lines

These lines:

  Range("GA2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
  Range("HB2").Resize(UBound(c, 1), UBound(c, 2)).Value = c

 

[DanteAmor]

Another setting ?‍

Before running the macro you must delete all formulas and data from columns AF to AI
Consider this macro:

Sub Replace_Formulas()
  Dim a As Variant, b As Variant, c As Variant
  Dim bb As Variant, at As Variant, bt As Variant, x As Variant, y As Variant
  Dim i As Long, j As Long, k As Long, m As Long, n As Long, lrb As Long, lrt As Long
  Dim dicGA As Object, dicJF As Object, dicBB As Object
  Dim dt1 As Date, dt2 As Date
  Dim ky1 As String, ky2 As String, cad As String
 
  If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
  Set dicGA = CreateObject("Scripting.Dictionary")
  Set dicJF = CreateObject("Scripting.Dictionary")
  Set dicBB = CreateObject("Scripting.Dictionary")
  dt1 = Range("AD1").Value  'date ini
  dt2 = Range("AE1").Value  'date fin
 
  'for each name to order the codes from column AT
  lrb = Range("B" & Rows.Count).End(3).Row
  lrt = Range("AT" & Rows.Count).End(3).Row
  bb = Range("B2:B" & lrb)
  at = Range("AT2:AT" & lrt)
  ReDim bt(1 To UBound(bb, 1) * UBound(at, 1), 1 To 4)
  For i = 1 To UBound(bb, 1)
    If Not dicBB.exists(bb(i, 1)) Then
      dicBB(bb(i, 1)) = Empty
      For j = 1 To UBound(at, 1)
        n = n + 1
        bt(n, 1) = bb(i, 1)
        bt(n, 3) = at(j, 1)
      Next
    End If
  Next
 
  a = Range("A2:AH" & lrb).Value
  ReDim b(1 To UBound(a, 1), 1 To 26)
  ReDim c(1 To UBound(a, 1), 1 To 26)
 
  For i = 1 To UBound(a, 1)
    j = 0
    cad = ""
    For Each x In Split(a(i, 10), "+")    'column J
      j = j + 1
      b(i, j) = x
   
      'CountIfs
      If a(i, 4) >= dt1 And a(i, 4) <= dt2 Then
        If InStr(1, cad, x, vbTextCompare) = 0 Then
          ky2 = a(i, 2) & "|" & x
          dicJF(ky2) = dicJF(ky2) + 1
        End If
        cad = cad & x
      End If
    Next
   
    k = 0
    For Each y In Split(a(i, 16), "+")    'column P
      k = k + 1
      c(i, k) = y
     
      'SumProduct
      If a(i, 4) >= dt1 And a(i, 4) <= dt2 Then
        ky1 = a(i, 2) & "|" & b(i, k)
        dicGA(ky1) = dicGA(ky1) + Val(y)
      End If
    Next
  Next
 
  For i = 1 To n
    ky1 = bt(i, 1) & "|" & bt(i, 3)   'column AF | AH
    'SumProduct
    If dicGA.exists(ky1) Then bt(i, 2) = dicGA(ky1) Else bt(i, 2) = 0
    'CountIfs
    If dicJF.exists(ky1) Then bt(i, 4) = dicJF(ky1) Else bt(i, 4) = 0
  Next
  Range("GA2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
  Range("HB2").Resize(UBound(c, 1), UBound(c, 2)).Value = c
  Range("AF2").Resize(n, 4).Value = bt
End Sub

 

[K0st4din]

Hello from me too.
I was sure we would make it to the finals. It was obviously beer. I'm glad you have a sense of humor.
The macro is already 98%. I will upload a photo to fix 2 things (I wrote about one in the previous comments).
The first thing I don't need: The names are sorted, the codes are sorted, everything is calculated, please let's remove these 0 (they have nothing to calculate down, because they follow the names).

And the second thing I try to do on my own, but I can't do it alone. I think it should be fine from here, but I can't.

If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False - I thing must be TRUE, to save again filter mode in worksheet, but give me error. From A:Z

Thank you again and again, for two years I struggled to do everything by hand.
You are an AMAZING MAN and thank you from all of my heart!

 

[DanteAmor]

If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False - I thing must be TRUE, to save again filter mode in worksheet, but give me error. From A:Z

Let me explain, the previous instruction is to remove the filter from the sheet, so that all the rows can be seen, to be able to read the data, and of course, put the result. So it must be False.

To put the autofilter you just have to put this line at the end of the macro.
After this line:

  Range("AF2").Resize(n, 4).Value = bt

Put this line:

  Range("A1:Z1").AutoFilter

-------------------------------------------------------------

please let's remove these 0

My macro does not put zeros. You must delete all formulas and data in columns AF through AI. I had already told you this in previous posts.

Check that in the columns "B" and "AT" you do not have cells with blank spaces. After the last data you should have empty cells.
If you follow the instructions correctly, the zeros should not appear.

If the zeros still appear, then change these lines:

  For i = 1 To n
    ky1 = bt(i, 1) & "|" & bt(i, 3)   'column AF | AH
    'SumProduct
    If dicGA.exists(ky1) Then bt(i, 2) = dicGA(ky1) Else bt(i, 2) = 0
    'CountIfs
    If dicJF.exists(ky1) Then bt(i, 4) = dicJF(ky1) Else bt(i, 4) = 0
  Next
  Range("GA2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
  Range("HB2").Resize(UBound(c, 1), UBound(c, 2)).Value = c
  Range("AF2").Resize(n, 4).Value = bt

For these:

  For i = 1 To n
    ky1 = bt(i, 1) & "|" & bt(i, 3)   'column AF | AH
    'SumProduct
    bt(i, 2) = dicGA(ky1)
    'CountIfs
    bt(i, 4) = dicJF(ky1)
  Next
  Range("GA2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
  Range("HB2").Resize(UBound(c, 1), UBound(c, 2)).Value = c
  Range("AF2:AI" & Rows.Count).ClearContents
  Range("AF2").Resize(n, 4).Value = bt
  Range("A1:Z1").AutoFilter

--------------------------
If the zeros are still showing, then share your test file to review your data. In the tests that I have carried out with your sheet that you shared, those zeros do not appear.

--------------------------
It seems very demanding on your part that you disqualify my macro for those details, which are not a problem with my macro, they are problems with your data.

 

[K0st4din]

Hello wonderful man
Yes, everything has been added and now it works at 100000%.
I have marked that everything is OK and the problem is solved!
Please excuse me if I annoyed you with this deletion of everything before using the macro. It was not a deliberate, but a misreading of what you wrote about this erasure.
I just thought that the written macro would do it, and it had to reset everything before the test.
Please excuse me once again, it was not intentionally 100000%.
If there was an opportunity in the system, I would give you countless stars and ranks for this help.
Thank you very much for this help!
In these difficult times, I wish you to be alive and healthy and do not stop helping people like me! ???

 

[K0st4din]

Hello DanteAmor
i think i have a little problem with the macro.
The idea is that it works, but at certain moments.
So we take strictly defined codes, which are in column AT2-to the end, then for each name in column B2:B - we put to repeat these codes.
Then we start looking at the codes in column J2-to the end. Right here, now that I'm working with the real data, it turns out that in this same column J,
I also have codes that I'm not interested in and are not set in column AT2-to the end (the codes are transferred against each one at the same time). name in column AH2-to the end, according to the names).
That is, if I have codes in B2:B, but they are not set in column AT2: to the end, it gives me the following error.

link to my tested file: Loading Google Sheets

I have no explanation why he works in some worksheets and doesn't want to work in others?
Please keep an eye on why this is happening.
Thank you very much.

 

[K0st4din]

Hello again,
I spent almost all night trying to try and see if I was mistaken in some way, but unfortunately I found that I could not find the problem.
It doesn't matter if I only have 1 name and one date in the name column or I have 5670 rows of names and different codes and dates. Somewhere the macro works super well, somewhere it doesn't want to start over and over again with the same error.
I don't have any blank lines, everything is arranged one below the other. There are no different types of dates or anything that could be an error in my file. What I mentioned is that in column J2-to the end I have codes in a worksheet that I don't need and I haven't exported to column AT2-to the end. But I don't think that's a problem either, because in some worksheets it works, in others it doesn't work, regardless of the products am looking for.
Thanks again for your cooperation.