Bomino
Member
Hello,
I've been reading on Excel VBA Loops & Arrays (Passing Arrays to procedures......) and spent quite some time working on the attached file. I finally got it working fine; but I believe the result needs some expert's touch.
I was wondering if , using Arrays or Dictionaries or Collections, it is possible to tweak (or even combine) the following 2 codes. The desired output is shown in attached file , Tab "Calculations", Range("V2:AL13). My main issue is speed, as the raw data is pretty huge.
Any help would be greatly appreciated. Thank you.
I've been reading on Excel VBA Loops & Arrays (Passing Arrays to procedures......) and spent quite some time working on the attached file. I finally got it working fine; but I believe the result needs some expert's touch.
I was wondering if , using Arrays or Dictionaries or Collections, it is possible to tweak (or even combine) the following 2 codes. The desired output is shown in attached file , Tab "Calculations", Range("V2:AL13). My main issue is speed, as the raw data is pretty huge.
Any help would be greatly appreciated. Thank you.
Code:
LastRowWkd = Descrp.Range("H" & Rows.Count).End(xlUp).Row
LastRowSites = Descrp.Range("B" & Rows.Count).End(xlUp).Row
Set SiteIDrng = Descrp.Range("A2:B" & LastRowSites)
Sites = SiteIDrng
Set Rng1 = Descrp.Range("H2:J" & LastRowWkd)
MyWkdDate = Rng1
Set Rng2 = Descrp.Range("A2:A" & LastRowSites)
MySites = Rng2
Set DateDest = Matheux.Range("A2")
DateDest.Resize(UBound(MyWkdDate, 1), UBound(MyWkdDate, 2)).Value2 = MyWkdDate
Set SiteDest = Matheux.Range("D1")
SiteDest.Resize(UBound(MySites, 2), UBound(MySites, 1)).Value2 = Application.Transpose(MySites)
Set SiteID = Report.Range("C6")
SiteID.Resize(UBound(Sites, 1), UBound(Sites, 2)).Value2 = Sites
lcol = LastRowSites + 2
With Matheux
.Cells(1, lcol).Offset(0, 1) = "All Sites Weekly Average"
For k = 2 To LastRowWkd
For Z = 4 To lcol
.Cells(k, Z) = WorksheetFunction.CountIfs(Data.[EndingDate], .Cells(k, 1), Data.[LocationDesc], .Cells(1, Z))
.Cells(k, Z).NumberFormat = "0"
Next
'~~~> Determining the Range for dynamic Rows & Columns
'~~~~> rng=.Range(StartCell,.Cells(LastRow,LAstColumn)
Set rng = .Range(.Cells(k, 4), .Cells(k, lcol))
'~~~> Average number of Employees by Weekending Date
.Cells(k, lcol).Offset(0, 1) = WorksheetFunction.AverageIf(rng, ">0", rng)
.Cells(k, lcol).Offset(0, 1).NumberFormat = "0"
Next
End With
Code:
With Matheux
LrSite = .Range("W" & Rows.Count).End(xlUp).Row
LastCol = .Cells(LrSite, Columns.Count).End(xlToLeft).Column
Set ClrRng = .Range(.Cells(1, 24), .Cells(LrSite, LastCol))
ClrRng.ClearContents
'~~~> Month
A = Descrp.[selyear].Text
Z = 24
For i = 2 To LastRow
B = Descrp.Cells(i, 13).Text
If A = B Then
.Cells(1, Z) = Descrp.Cells(i, 12)
.Cells(1, Z).NumberFormat = "mmm-yy"
.Cells(1, Z).Font.Bold = True
.Cells(1, Z).ColumnWidth = 9.43
Z = Z + 1
End If
Next i
LastRowCalc = .Range("A" & Rows.Count).End(xlUp).Row
LastColCalc = 16
Lc = .Cells(1, Columns.Count).End(xlToLeft).Column
On Error Resume Next
For k = 24 To Lc
For Y = 4 To LastColCalc
For j = 2 To LrSite
Set ColSiteRng = .Range(.Cells(2, Y), .Cells(LastRowCalc, Y))
Set ColMonthRng = .Range(.Cells(2, 2), .Cells(LastRowCalc, 2))
.Cells(j, k) = Application.WorksheetFunction.AverageIfs(ColSiteRng, ColMonthRng, .Cells(1, k), ColSiteRng, ">0")
.Cells(j, k).NumberFormat = "0"
Y = Y + 1
Next
Next
Next
End With