Formula Sumproduct is taking very long time to update data results.

Kishan

Well-known Member
Joined
Mar 15, 2011
Messages
1,561
Using Excel 2000

Hi,

I was using the macro below with only 1000 - 1500 rows, but now I want to use and check played with 59000 rows extending the range it is taking 45-55 minutes to update data results.

My enquiry is it any other formulas or VBA code which can reduce the time for update data results.

In the column "A" there is entered year.
In the column "B" there is entered results.
In the column "C" there is Check Played.

Row 3 has header.... Year, Results, check Played, and year to check 00/01 to 19/20

When I run the macro below it takes 45 - 55 minutes

*ABCDEFGHIJKLMNOPQRSTUVWXY
1
2
3YearResultsCheck Played00/0101/0202/0303/0404/0505/0606/0707/0808/0909/1010/1111/1212/1313/1414/1515/1616/1717/1818/1919/20
400/01XX10000000000000000000
500/01X | 11 | 2 | 1 | 2 | X | 1 | 1 | 2 | X00000000000000000001
601/02X | XX | X01000000000000000000
701/021 | 1 | 11 | X | X | 1 | 2 | 1 | 2 | 1 | 100000000000000000001
801/02X | 1 | 1X | 1 | 101000000000000000000
901/021 | 1 | 11 | 2 | 200000000000000000000
1002/031 | 1 | 1 | 2X | 1 | X | 1 | X | 1 | 1 | X00000000000000100000
1102/031 | X | 2 | 11 | X | 1 | X00100000000000000000
1202/031 | X | 1 | X1 | 1 | 1 | 200100000000000000000
1302/03X | X | X | 11 | X | X | 100000000000000000000
1402/03X | X | 2 | 21 | X | X | X00000000000000000000
1503/041 | 1 | 2 | 11 | X | X | 200000000000000000000
1603/04X | 1 | 1 | 11 | X | 2 | 100100000000000000000
1703/04X | 2 | X | 1 | 11 | 1 | X | 1 | 100000000000000000000
1803/041 | 1 | 1 | 1 | 11 | 1 | X | 1 | X00000000000000000000
1903/041 | 2 | 1 | 2 | XX | X | X | 100100000000000000000
2006/071 | X | X | 1 | 11 | 1 | X | X | 100000000000000000000
2106/071 | X | X | 1 | 11 | 1 | X | X | X00000000000000000000
2206/071 | 1 | 1 | X | 11 | 1 | X | X | 200000000000000000000
2306/07X | 1 | 2 | X | 11 | 1 | X | 2 | 100000000000000000000
2406/071 | 1 | 1 | X | 12 | 1 | X | 1 | 1 | 1 | 1 | 100000000001000000000
2508/091 | 1 | 1 | 1 | 11 | 1 | X | 2 | 200000000000000000000
2608/091 | 1 | 1 | 1 | 11 | 1 | 2 | 1 | 100000000000000000000
2708/092 | 1 | X | 1 | 1 | 11 | 1 | 1 | X | 1 | 100000000000000000000
2808/091 | 1 | 1 | 1 | X | 11 | 1 | 1 | X | 1 | X00000000000000000000
2908/09X | 1 | 2 | 1 | 2 | X1 | X | 1 | 1 | X | X | 2 | 200000000000000100000
3008/091 | X | 2 | 2 | 2 | 11 | 1 | 1 | X | X | 100000000000000000000
3110/111 | X | 1 | 1 | X | X1 | 1 | 1 | X | X | X00000000000000000000
3210/111 | X | 1 | 2 | 2 | 11 | 1 | 1 | X | X | 200000000000000000000
3310/11X | 1 | X | 1 | X | 1X | 1 | 2 | 1 | 2 | X | X | 100000000000001000000
3410/11X | X | X | 1 | 1 | 11 | 1 | 1 | X | 2 | X00000000000000000000
3510/111 | 1 | 1 | 1 | 2 | 1 | X | 1X | 1 | 2 | 1 | 2 | X | X | 100000000000001000000
3610/112 | X | 2 | X | 1 | 2 | 1 | XX | 1 | 2 | 1 | 2 | X | X | 100000000000001000000
3710/112 | 1 | X | 1 | 1 | 1 | 1 | 1X | 1 | 2 | 1 | 2 | X | X | 100000000000001000000
3811/121 | 1 | 1 | 1 | X | 1 | X | 11 | 1 | 1 | 1 | 2 | 1 | 2 | X00000000000000000000
3913/14X | 1 | 2 | 1 | 2 | X | X | 1X | 1 | 2 | 1 | 2 | X | X | 100000000000001000000
4013/141 | X | 2 | 2 | 2 | 1 | X | X1 | 1 | 1 | 1 | 2 | X | 1 | 100000000000000000000
4114/151 | X | 1 | 1 | X | X | 2 | 21 | 1 | 1 | 1 | 2 | X | 1 | X00000000000000000000
4214/151 | X | 1 | 2 | 2 | 1 | X | 11 | X | 2 | 2 | 2 | 1 | X | X | 200000000000000000100
4314/15X | 1 | X | 1 | X | 1 | 1 | X1 | 1 | 1 | 1 | 2 | X | X | 100000000000000000000
4414/15X | X | X | 1 | 1 | 1 | 1 | X1 | 1 | 1 | 1 | 2 | X | X | X00000000000000000000
4516/172 | X | 1 | 1 | 1 | 2 | X | X1 | 1 | 1 | 1 | 2 | X | X | 200000000000000000000
4616/172 | 1 | X | 1 | 1 | 1 | 1 | 1 | 21 | 1 | 1 | 2 | 1 | 2 | 1 | 2 | 200000000000000000000
4716/171 | 1 | 1 | 1 | X | 1 | X | 1 | 21 | 1 | 1 | 2 | 1 | 2 | X | 1 | 100000000000000000000
4817/08X | 1 | 2 | 1 | 2 | X | X | 1 | 11 | 1 | 1 | 2 | 1 | 2 | X | 1 | X00000000000000000000
4917/181 | X | 2 | 2 | 2 | 1 | X | X | 21 | 1 | 1 | 2 | 1 | 2 | X | 1 | 200000000000000000000
5017/181 | X | 1 | 1 | X | X | 2 | 2 | X1 | 1 | 1 | 2 | 1 | 2 | X | X | 100000000000000000000
5118/191 | X | 1 | 2 | 2 | 1 | X | 1 | 1X | 1 | 1 | 100010000000000000000
5218/19X | 1 | X | 1 | X | 1 | 1 | X | 11 | 1 | 1 | 2 | 1 | 2 | X | X | 200000000000000000000
5318/19X | X | X | 1 | 1 | 1 | 1 | X | 11 | 1 | 1 | 2 | 1 | 2 | X | 2 | 100000000000000000000
5419/202 | X | 1 | 1 | 1 | 2 | X | X | X1 | X | 1 | 2 | 2 | 100000000001000000000
5519/20X | 1 | X | X | 1 | 1 | 1 | 1 | 11 | 1 | 1 | 2 | 1 | 2 | X | 2 | 200000000000000000000
5619/201 | X | X | 1 | 2 | 1 | 2 | 1 | 11 | 1 | 1 | 2 | 1 | 2 | 2 | 1 | 100000000000000000000
5719/20X | 2 | X | 1 | 1 | X | 1 | 1 | 11 | 1 | 1 | 2 | 1 | 2 | 2 | 1 | X00000000000000000000
5819/201 | 1 | 1 | 1 | 1 | 1 | X | X | XX | 2 | X | 1 | 100010000000000000000
5919/201 | 2 | 1 | 2 | X | 1 | 1 | 2 | X1 | 1 | 1 | 1 | X | 1 | X | 1 | 200000000000000001000
60
61

VBA Code:
Sub FillFormlas_SUMPRODUCT()
   
           
      Sheets("Sumproduct").Select
      Range("E4:X59003").ClearContents
      Range("E4").Select
     

     
     Dim lngLastRow As Long
     lngLastRow = Cells(Rows.Count, "C").End(xlUp).Row
'-------------------------------------------------------------
    Application.ScreenUpdating = False
'-------------------------------------------------------------
   
     Range("E4:X" & lngLastRow).Formula = "=SUMPRODUCT(--($B$4:$B$5004=$C4),--($A$4:$A$5004=E$3))"
     Range("E5:X" & lngLastRow) = Range("E5:X" & lngLastRow).Value 'Convert Values

'-------------------------------------------------------------
    Application.ScreenUpdating = True
'-------------------------------------------------------------
End Sub

Thank you in advance

Regards,
Kishan
 

Attachments

  • SUMPRODUCT.png
    SUMPRODUCT.png
    96 KB · Views: 9

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
13,773
Office Version
  1. 2007
Platform
  1. Windows
Try the following code takes 9 seconds with 65,000 records in column A and 20 columns from E to X.

VBA Code:
Sub Fill_Arrays()
  Dim a As Variant, b As Variant, c As Variant
  Dim i As Long, j As Long
  Dim dic As Object
  Dim llave As String
  
  Sheets("Sumproduct").Select
  
  Set dic = CreateObject("Scripting.Dictionary")
  Range("E4:X" & Rows.Count).ClearContents
  a = Range("A4:C" & Range("A" & Rows.Count).End(3).Row).Value
  b = Range("E3:X3").Value
  ReDim c(1 To UBound(a, 1), 1 To 20)
  
  For i = 1 To UBound(a, 1)
    llave = a(i, 1) & "|" & a(i, 2)
    dic(llave) = dic(llave) + 1
  Next
  
  For i = 1 To UBound(a, 1)
    For j = 1 To UBound(b, 2)
      llave = b(1, j) & "|" & a(i, 3)
      If dic.exists(llave) Then c(i, j) = dic(llave) Else c(i, j) = 0
    Next
  Next
  
  Range("E4").Resize(UBound(c, 1), UBound(c, 2)).Value = c
End Sub
 

Kishan

Well-known Member
Joined
Mar 15, 2011
Messages
1,561
Try the following code takes 9 seconds with 65,000 records in column A and 20 columns from E to X.

VBA Code:
Sub Fill_Arrays()
  Dim a As Variant, b As Variant, c As Variant
  Dim i As Long, j As Long
  Dim dic As Object
  Dim llave As String
 
  Sheets("Sumproduct").Select
 
  Set dic = CreateObject("Scripting.Dictionary")
  Range("E4:X" & Rows.Count).ClearContents
  a = Range("A4:C" & Range("A" & Rows.Count).End(3).Row).Value
  b = Range("E3:X3").Value
  ReDim c(1 To UBound(a, 1), 1 To 20)
 
  For i = 1 To UBound(a, 1)
    llave = a(i, 1) & "|" & a(i, 2)
    dic(llave) = dic(llave) + 1
  Next
 
  For i = 1 To UBound(a, 1)
    For j = 1 To UBound(b, 2)
      llave = b(1, j) & "|" & a(i, 3)
      If dic.exists(llave) Then c(i, j) = dic(llave) Else c(i, j) = 0
    Next
  Next
 
  Range("E4").Resize(UBound(c, 1), UBound(c, 2)).Value = c
End Sub
DanteAmor, I am speechless code work for me like magical it is just amazing your code has reduced the time of execution comparing to my formula 9 second "from the 55 minutes" just took eye-blinking time fantastic!! Job Dante. 🙌

I really appreciate your kind help for such a magnificent solution. 🍻

Please I want one more favour if it could be adapted not sure, say for example I want to remove from here the column "A" and the column "B" and want to palace them in the new sheet "Results", in this case the sheet "Sumproduct" column "A" & "B" will remain empty and rest all column "C" till column "X" will be stay the same as it is.

Kind Regards
Kishan :)
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
13,773
Office Version
  1. 2007
Platform
  1. Windows
I want to remove from here the column "A" and the column "B" and want to palace them in the new sheet "Results"
Try this:

VBA Code:
Sub Fill_Arrays()
  Dim a As Variant, b As Variant, c As Variant, d As Variant
  Dim i As Long, j As Long
  Dim dic As Object
  Dim llave As String
  
  Sheets("Sumproduct").Select
  
  Set dic = CreateObject("Scripting.Dictionary")
  Range("E4:X" & Rows.Count).ClearContents
  a = Sheets("Results").Range("A4:B" & Sheets("Results").Range("A" & Rows.Count).End(3).Row).Value
  b = Range("E3:X3").Value
  d = Range("C4:C" & Range("C" & Rows.Count).End(3).Row).Value
  
  ReDim c(1 To UBound(a, 1), 1 To 20)
  
  For i = 1 To UBound(a, 1)
    llave = a(i, 1) & "|" & a(i, 2)
    dic(llave) = dic(llave) + 1
  Next
  
  For i = 1 To UBound(d, 1)
    For j = 1 To UBound(b, 2)
      llave = b(1, j) & "|" & d(i, 1)
      If dic.exists(llave) Then c(i, j) = dic(llave) Else c(i, j) = 0
    Next
  Next
  
  Range("E4").Resize(UBound(c, 1), UBound(c, 2)).Value = c
End Sub
 
Solution

Kishan

Well-known Member
Joined
Mar 15, 2011
Messages
1,561

ADVERTISEMENT

Try this:

VBA Code:
Sub Fill_Arrays()
  Dim a As Variant, b As Variant, c As Variant, d As Variant
  Dim i As Long, j As Long
  Dim dic As Object
  Dim llave As String
 
  Sheets("Sumproduct").Select
 
  Set dic = CreateObject("Scripting.Dictionary")
  Range("E4:X" & Rows.Count).ClearContents
  a = Sheets("Results").Range("A4:B" & Sheets("Results").Range("A" & Rows.Count).End(3).Row).Value
  b = Range("E3:X3").Value
  d = Range("C4:C" & Range("C" & Rows.Count).End(3).Row).Value
 
  ReDim c(1 To UBound(a, 1), 1 To 20)
 
  For i = 1 To UBound(a, 1)
    llave = a(i, 1) & "|" & a(i, 2)
    dic(llave) = dic(llave) + 1
  Next
 
  For i = 1 To UBound(d, 1)
    For j = 1 To UBound(b, 2)
      llave = b(1, j) & "|" & d(i, 1)
      If dic.exists(llave) Then c(i, j) = dic(llave) Else c(i, j) = 0
    Next
  Next
 
  Range("E4").Resize(UBound(c, 1), UBound(c, 2)).Value = c
End Sub
DanteAmor, thank you so much for modifying as per new request, it worked perfect!! 👌

I am grateful to you for giving a great and timesaver solution. 😮

You have a great time and Good Luck.

Kind Regards
Kishan 😊
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
13,773
Office Version
  1. 2007
Platform
  1. Windows
I'm glad to help you. Thanks for the feedback. :giggle:
 

Kishan

Well-known Member
Joined
Mar 15, 2011
Messages
1,561

ADVERTISEMENT

I'm glad to help you. Thanks for the feedback. :giggle:
DanteAmor, I need third time one more favour from you can you assist me with following project.

I want slightly different result from post#1 in the column "C" I want to check alternate row and result in the same row starting from column "E6" in to alternating row too as shown in the image attached.

Please can you hep to modify VBA is in the post#2 to be adapted for this new scenario?

*ABCDEFGHIJKLMNOPQRSTUVW
1
2
3YearResultsCheck Played00/0101/0202/0303/0404/0505/0606/0707/0808/0909/1010/1111/1212/1313/1414/1515/1616/1717/1818/1919/20
400/01XX
500/01X | 1X10000000000000000000
601/02X | XX | X
701/021 | 1 | 1X | X01000000000000000000
801/02X | 1 | 1X | 1 | 1
901/021 | 1 | 1X | 1 | 101000000000000000000
1002/031 | 1 | 1 | 2X | 1 | X | 1 | X | 1 | 1 | X
1102/031 | X | 2 | 1X | 1 | X | 1 | X | 1 | 1 | X00000000000000100000
1202/031 | X | 1 | X1 | 1 | 1 | 2
1302/03X | X | X | 11 | 1 | 1 | 200100000000000000000
1402/03X | X | 2 | 21 | X | X | X
1503/041 | 1 | 2 | 11 | X | X | X00000000000000000000
1603/04X | 1 | 1 | 11 | X | 2 | 1
1703/04X | 2 | X | 1 | 11 | X | 2 | 100100000000000000000
1803/041 | 1 | 1 | 1 | 11 | 1 | X | 1 | X
1903/041 | 2 | 1 | 2 | X1 | 1 | X | 1 | X00000000000000000000
2006/071 | X | X | 1 | 11 | 1 | X | X | 1
2106/071 | X | X | 1 | 11 | 1 | X | X | 100000000000000000000
2206/071 | 1 | 1 | X | 11 | 1 | X | X | 2
2306/07X | 1 | 2 | X | 11 | 1 | X | X | 200000000000000000000
2406/071 | 1 | 1 | X | 12 | 1 | X | 1 | 1 | 1 | 1 | 1
2508/091 | 1 | 1 | 1 | 12 | 1 | X | 1 | 1 | 1 | 1 | 100000000001000000000
2608/091 | 1 | 1 | 1 | 11 | 1 | 2 | 1 | 1
2708/092 | 1 | X | 1 | 1 | 11 | 1 | 2 | 1 | 100000000000000000000
2808/091 | 1 | 1 | 1 | X | 11 | 1 | 1 | X | 1 | X
2908/09X | 1 | 2 | 1 | 2 | X1 | 1 | 1 | X | 1 | X00000000000000000000
3008/091 | X | 2 | 2 | 2 | 11 | 1 | 1 | X | X | 1
3110/111 | X | 1 | 1 | X | X1 | 1 | 1 | X | X | 100000000000000000000
3210/111 | X | 1 | 2 | 2 | 11 | 1 | 1 | X | X | 2
3310/11X | 1 | X | 1 | X | 11 | 1 | 1 | X | X | 200000000000000000000
3410/11X | X | X | 1 | 1 | 11 | 1 | 1 | X | 2 | X
3510/111 | 1 | 1 | 1 | 2 | 1 | X | 11 | 1 | 1 | X | 2 | X00000000000000000000
3610/112 | X | 2 | X | 1 | 2 | 1 | XX | 1 | 2 | 1 | 2 | X | X | 1
3710/112 | 1 | X | 1 | 1 | 1 | 1 | 1X | 1 | 2 | 1 | 2 | X | X | 100000000000001000000
3811/121 | 1 | 1 | 1 | X | 1 | X | 11 | 1 | 1 | 1 | 2 | 1 | 2 | X
3913/14X | 1 | 2 | 1 | 2 | X | X | 11 | 1 | 1 | 1 | 2 | 1 | 2 | X00000000000000000000
4013/141 | X | 2 | 2 | 2 | 1 | X | X1 | 1 | 1 | 1 | 2 | X | 1 | 1
4114/151 | X | 1 | 1 | X | X | 2 | 21 | 1 | 1 | 1 | 2 | X | 1 | 100000000000000000000
4214/151 | X | 1 | 2 | 2 | 1 | X | 11 | X | 2 | 2 | 2 | 1 | X | X | 2
4314/15X | 1 | X | 1 | X | 1 | 1 | X1 | X | 2 | 2 | 2 | 1 | X | X | 200000000000000000100
4414/15X | X | X | 1 | 1 | 1 | 1 | X1 | 1 | 1 | 1 | 2 | X | X | X
4516/172 | X | 1 | 1 | 1 | 2 | X | X1 | 1 | 1 | 1 | 2 | X | X | X00000000000000000000
4616/172 | 1 | X | 1 | 1 | 1 | 1 | 1 | 21 | 1 | 1 | 2 | 1 | 2 | 1 | 2 | 2
4716/171 | 1 | 1 | 1 | X | 1 | X | 1 | 21 | 1 | 1 | 2 | 1 | 2 | 1 | 2 | 200000000000000000000
4817/08X | 1 | 2 | 1 | 2 | X | X | 1 | 11 | 1 | 1 | 2 | 1 | 2 | X | 1 | X
4917/181 | X | 2 | 2 | 2 | 1 | X | X | 21 | 1 | 1 | 2 | 1 | 2 | X | 1 | X00000000000000000000
5017/181 | X | 1 | 1 | X | X | 2 | 2 | X1 | 1 | 1 | 2 | 1 | 2 | X | X | 1
5118/191 | X | 1 | 2 | 2 | 1 | X | 1 | 11 | 1 | 1 | 2 | 1 | 2 | X | X | 100000000000000000000
5218/19X | 1 | X | 1 | X | 1 | 1 | X | 11 | 1 | 1 | 2 | 1 | 2 | X | X | 2
5318/19X | X | X | 1 | 1 | 1 | 1 | X | 11 | 1 | 1 | 2 | 1 | 2 | X | X | 200000000000000000000
5419/202 | X | 1 | 1 | 1 | 2 | X | X | X1 | X | 1 | 2 | 2 | 1
5519/20X | 1 | X | X | 1 | 1 | 1 | 1 | 11 | X | 1 | 2 | 2 | 100000000001000000000
5619/201 | X | X | 1 | 2 | 1 | 2 | 1 | 11 | 1 | 1 | 2 | 1 | 2 | 2 | 1 | 1
5719/20X | 2 | X | 1 | 1 | X | 1 | 1 | 11 | 1 | 1 | 2 | 1 | 2 | 2 | 1 | 100000000000000000000
5819/201 | 1 | 1 | 1 | 1 | 1 | X | X | XX | 2 | X | 1 | 1
5919/201 | 2 | 1 | 2 | X | 1 | 1 | 2 | XX | 2 | X | 1 | 100010000000000000000

Thank you in advance

Regards,
Kishan
 

Attachments

  • Sumproduct-New List.png
    Sumproduct-New List.png
    81.6 KB · Views: 4

Kishan

Well-known Member
Joined
Mar 15, 2011
Messages
1,561
DanteAmor, just I want to put a note; if VBA checks alternative rows it must write result in the alternative row if there is any numbers entered manually in the blank rows 4, 6, 8 or in the any blank row should not erase them.

Regards,
Kishan
 

Kishan

Well-known Member
Joined
Mar 15, 2011
Messages
1,561
DanteAmor, I need third time one more favour from you can you assist me with following project.

I want slightly different result from post#1 in the column "C" I want to check alternate row and result in the same row starting from column "E6" in to alternating row too as shown in the image attached.

Please can you hep to modify VBA is in the post#2 to be adapted for this new scenario?

*ABCDEFGHIJKLMNOPQRSTUVW
1
2
3YearResultsCheck Played00/0101/0202/0303/0404/0505/0606/0707/0808/0909/1010/1111/1212/1313/1414/1515/1616/1717/1818/1919/20
400/01XX
500/01X | 1X10000000000000000000
601/02X | XX | X
701/021 | 1 | 1X | X01000000000000000000
801/02X | 1 | 1X | 1 | 1
901/021 | 1 | 1X | 1 | 101000000000000000000
1002/031 | 1 | 1 | 2X | 1 | X | 1 | X | 1 | 1 | X
1102/031 | X | 2 | 1X | 1 | X | 1 | X | 1 | 1 | X00000000000000100000
1202/031 | X | 1 | X1 | 1 | 1 | 2
1302/03X | X | X | 11 | 1 | 1 | 200100000000000000000
1402/03X | X | 2 | 21 | X | X | X
1503/041 | 1 | 2 | 11 | X | X | X00000000000000000000
1603/04X | 1 | 1 | 11 | X | 2 | 1
1703/04X | 2 | X | 1 | 11 | X | 2 | 100100000000000000000
1803/041 | 1 | 1 | 1 | 11 | 1 | X | 1 | X
1903/041 | 2 | 1 | 2 | X1 | 1 | X | 1 | X00000000000000000000
2006/071 | X | X | 1 | 11 | 1 | X | X | 1
2106/071 | X | X | 1 | 11 | 1 | X | X | 100000000000000000000
2206/071 | 1 | 1 | X | 11 | 1 | X | X | 2
2306/07X | 1 | 2 | X | 11 | 1 | X | X | 200000000000000000000
2406/071 | 1 | 1 | X | 12 | 1 | X | 1 | 1 | 1 | 1 | 1
2508/091 | 1 | 1 | 1 | 12 | 1 | X | 1 | 1 | 1 | 1 | 100000000001000000000
2608/091 | 1 | 1 | 1 | 11 | 1 | 2 | 1 | 1
2708/092 | 1 | X | 1 | 1 | 11 | 1 | 2 | 1 | 100000000000000000000
2808/091 | 1 | 1 | 1 | X | 11 | 1 | 1 | X | 1 | X
2908/09X | 1 | 2 | 1 | 2 | X1 | 1 | 1 | X | 1 | X00000000000000000000
3008/091 | X | 2 | 2 | 2 | 11 | 1 | 1 | X | X | 1
3110/111 | X | 1 | 1 | X | X1 | 1 | 1 | X | X | 100000000000000000000
3210/111 | X | 1 | 2 | 2 | 11 | 1 | 1 | X | X | 2
3310/11X | 1 | X | 1 | X | 11 | 1 | 1 | X | X | 200000000000000000000
3410/11X | X | X | 1 | 1 | 11 | 1 | 1 | X | 2 | X
3510/111 | 1 | 1 | 1 | 2 | 1 | X | 11 | 1 | 1 | X | 2 | X00000000000000000000
3610/112 | X | 2 | X | 1 | 2 | 1 | XX | 1 | 2 | 1 | 2 | X | X | 1
3710/112 | 1 | X | 1 | 1 | 1 | 1 | 1X | 1 | 2 | 1 | 2 | X | X | 100000000000001000000
3811/121 | 1 | 1 | 1 | X | 1 | X | 11 | 1 | 1 | 1 | 2 | 1 | 2 | X
3913/14X | 1 | 2 | 1 | 2 | X | X | 11 | 1 | 1 | 1 | 2 | 1 | 2 | X00000000000000000000
4013/141 | X | 2 | 2 | 2 | 1 | X | X1 | 1 | 1 | 1 | 2 | X | 1 | 1
4114/151 | X | 1 | 1 | X | X | 2 | 21 | 1 | 1 | 1 | 2 | X | 1 | 100000000000000000000
4214/151 | X | 1 | 2 | 2 | 1 | X | 11 | X | 2 | 2 | 2 | 1 | X | X | 2
4314/15X | 1 | X | 1 | X | 1 | 1 | X1 | X | 2 | 2 | 2 | 1 | X | X | 200000000000000000100
4414/15X | X | X | 1 | 1 | 1 | 1 | X1 | 1 | 1 | 1 | 2 | X | X | X
4516/172 | X | 1 | 1 | 1 | 2 | X | X1 | 1 | 1 | 1 | 2 | X | X | X00000000000000000000
4616/172 | 1 | X | 1 | 1 | 1 | 1 | 1 | 21 | 1 | 1 | 2 | 1 | 2 | 1 | 2 | 2
4716/171 | 1 | 1 | 1 | X | 1 | X | 1 | 21 | 1 | 1 | 2 | 1 | 2 | 1 | 2 | 200000000000000000000
4817/08X | 1 | 2 | 1 | 2 | X | X | 1 | 11 | 1 | 1 | 2 | 1 | 2 | X | 1 | X
4917/181 | X | 2 | 2 | 2 | 1 | X | X | 21 | 1 | 1 | 2 | 1 | 2 | X | 1 | X00000000000000000000
5017/181 | X | 1 | 1 | X | X | 2 | 2 | X1 | 1 | 1 | 2 | 1 | 2 | X | X | 1
5118/191 | X | 1 | 2 | 2 | 1 | X | 1 | 11 | 1 | 1 | 2 | 1 | 2 | X | X | 100000000000000000000
5218/19X | 1 | X | 1 | X | 1 | 1 | X | 11 | 1 | 1 | 2 | 1 | 2 | X | X | 2
5318/19X | X | X | 1 | 1 | 1 | 1 | X | 11 | 1 | 1 | 2 | 1 | 2 | X | X | 200000000000000000000
5419/202 | X | 1 | 1 | 1 | 2 | X | X | X1 | X | 1 | 2 | 2 | 1
5519/20X | 1 | X | X | 1 | 1 | 1 | 1 | 11 | X | 1 | 2 | 2 | 100000000001000000000
5619/201 | X | X | 1 | 2 | 1 | 2 | 1 | 11 | 1 | 1 | 2 | 1 | 2 | 2 | 1 | 1
5719/20X | 2 | X | 1 | 1 | X | 1 | 1 | 11 | 1 | 1 | 2 | 1 | 2 | 2 | 1 | 100000000000000000000
5819/201 | 1 | 1 | 1 | 1 | 1 | X | X | XX | 2 | X | 1 | 1
5919/201 | 2 | 1 | 2 | X | 1 | 1 | 2 | XX | 2 | X | 1 | 100010000000000000000

Thank you in advance

Regards,
Kishan
Try the following code takes 9 seconds with 65,000 records in column A and 20 columns from E to X.

VBA Code:
Sub Fill_Arrays()
  Dim a As Variant, b As Variant, c As Variant
  Dim i As Long, j As Long
  Dim dic As Object
  Dim llave As String
 
  Sheets("Sumproduct").Select
 
  Set dic = CreateObject("Scripting.Dictionary")
  Range("E4:X" & Rows.Count).ClearContents
  a = Range("A4:C" & Range("A" & Rows.Count).End(3).Row).Value
  b = Range("E3:X3").Value
  ReDim c(1 To UBound(a, 1), 1 To 20)
 
  For i = 1 To UBound(a, 1)
    llave = a(i, 1) & "|" & a(i, 2)
    dic(llave) = dic(llave) + 1
  Next
 
    For i = 1 To UBound(a, 1) 'to this--->For i = 1 To UBound(a, 1) Step 2
    For j = 1 To UBound(b, 2)
      llave = b(1, j) & "|" & a(i, 3)
      If dic.exists(llave) Then c(i, j) = dic(llave) Else c(i, j) = 0
    Next
  Next
 
  Range("E4").Resize(UBound(c, 1), UBound(c, 2)).Value = c
End Sub
DanteAmor, after so many hours changing many parameters I could manage to get result in the alternative odd rows finally changing the following highlighted row "For i = 1 To UBound(a, 1)" To this--> "For i = 1 To UBound(a, 1) Step 2" but now problem is this if i write any value or text in the empty rows all get vanish.

may now need to modified so it can write output only in the odd row
Range("E5").Resize(UBound(c, 1), UBound(c, 2)).Value = c

Please need your assistance with this task

Regards,
Kishan
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
13,773
Office Version
  1. 2007
Platform
  1. Windows
starting from column "E6"

Please can you hep to modify VBA is in the post#2 to be adapted for this new scenario?

Try the following, adaptation of the code from post #2

VBA Code:
Sub Fill_Arrays_1()
  Dim a As Variant, b As Variant, c As Variant
  Dim i As Long, j As Long, lr As Long
  Dim dic As Object
  Dim llave As String
  
  Sheets("Sumproduct").Select
  Set dic = CreateObject("Scripting.Dictionary")
  
  lr = Range("A" & Rows.Count).End(3).Row
  'starting from column "E6"
  a = Range("A6:C" & lr).Value
  b = Range("E3:X3").Value
  c = Range("E6:X" & lr).Value
  
  For i = 1 To UBound(a, 1) Step 2
    llave = a(i, 1) & "|" & a(i, 2)
    dic(llave) = dic(llave) + 1
  Next
  
  For i = 1 To UBound(a, 1) Step 2
    For j = 1 To UBound(b, 2)
      llave = b(1, j) & "|" & a(i, 3)
      If dic.exists(llave) Then
        If c(i, j) = "" Or c(i, j) = 0 Then
          c(i, j) = dic(llave)
        End If
      Else
        If c(i, j) = "" Then
          c(i, j) = 0
        End If
      End If
    Next
  Next
  
  'starting from column "E6"
  Range("E6").Resize(UBound(c, 1), UBound(c, 2)).Value = c
End Sub
 

Forum statistics

Threads
1,144,671
Messages
5,725,690
Members
422,635
Latest member
crisis

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top