Use VBA to complete calculations into a table

Catyclaire85

New Member
Joined
Nov 23, 2021
Messages
20
Office Version
  1. 2016
Platform
  1. Windows
HI,

I am stumped with how to approach this and don't know if it is possible in VBA. I have attached a dummy document, with correct headings, as I need to show in the summary the number of appointments by type and appointment status at Branch Level and on a monthly basis. In the next columns section I need to have the same for solutions and contributions by type.

I then need to calculate the FTE in the following columns per branch per month, multiplying the volume by the AHT, dividing by 60 then 21 then 7.

Can I do this using VBA as doing it with formulas in the cells keeps causing the whole thing to crash.

I have SQL code for the outcome I desire but not the facility to be able to use it.

SQL:
CREATE TABLE #calcs (
appt_date DATETIME,
branch VARCHAR(200),
appt_type VARCHAR(200),
appt_status VARCHAR(200),
appt_length INT,
volume INT
)

INSERT INTO #calcs VALUES
('2022/02/01', 'LLS', 'CA', 'Fulfilled', 60, 20),
('2022/03/01', 'LLS', 'Loan', 'Fulfilled', 60, 80),
('2023/02/01', 'LLS', 'DA', 'Fulfilled', 60, 20),
('2022/02/01', 'LLS', 'Loan', 'No Show', 60, 30),
('2022/02/01', 'LLS', 'CA', 'Not Updated', 60, 20),
('2022/01/01', 'LLS', 'CA', 'Fulfilled', 60, 20),
('2022/01/01', 'LLS', 'CA', 'Fulfilled', 45, 50),
('2022/02/01', 'LLS', 'CA', 'Fulfilled', 30, 50),
('2022/02/01', 'LLS', 'Loan', 'Fulfiled', 45, 70)

CREATE TABLE #vars(
year INT,
month INT,
working_days INT,
shrinkage DECIMAL(20,3)
)

INSERT INTO #vars VALUES
(2022, 2, 20, 0.253),
(2022, 3, 22, 0.351),
(2023, 2, 18, 0.253),
(2022, 1, 21, 0.253)

CREATE TABLE #results(
year INT,
month INT,
branch VARCHAR(200),
appt_type VARCHAR(200),
appt_status VARCHAR(200),
calc DECIMAL(32,2)
)

SELECT * FROM #calcs
SELECT * FROM #vars

INSERT INTO #results
SELECT year, month, branch, appt_type, appt_status,
ROUND( ROUND( ROUND( hours / working_days, 2) / 7, 2) * (1 + shrinkage), 2) calc
FROM ( SELECT YEAR(appt_date) year, MONTH(appt_date) month, branch, appt_type, appt_status,
ROUND( CAST( SUM( appt_length * volume ) AS DECIMAL(32,6) ) / 60, 2 ) hours
FROM #calcs
GROUP BY YEAR(appt_date), MONTH(appt_date), branch, appt_type, appt_status
) calcs
CROSS APPLY(
SELECT working_days, shrinkage
FROM #vars vars
WHERE calcs.year = vars.year
AND calcs.month = vars.month
) vars

SELECT year, month,
CASE month WHEN 1 THEN year - 1 ELSE year END prev_months_year,
CASE month WHEN 1 THEN 12 ELSE month - 1 END prev_month,
branch, appt_type, appt_status

FROM #results
WHERE appt_status IN('Fulfilled', 'Not Updated')

SELECT branch, appt_type, appt_status, year, month, prev_year, prev_month, calc, prev_calc, calc - prev_calc difference
 FROM(
SELECT year, month, branch, appt_type, appt_status, calc
FROM #results
WHERE appt_status IN('Fulfilled', 'Not Updated')
) curr
OUTER APPLY(
SELECT year prev_year, month prev_month, calc prev_calc
FROM #results prev
WHERE CASE curr.month WHEN 1 THEN curr.year - 1 ELSE curr.year END = prev.year
AND CASE curr.month WHEN 1 THEN 12 ELSE curr.month - 1 END = prev.month
AND curr.branch = prev.branch
AND curr.appt_type = prev.appt_type
AND curr.appt_status = prev.appt_status
) previous

DROP TABLE #calcs
DROP TABLE #vars
DROP TABLE #results
 

Attachments

  • Appt data example.png
    Appt data example.png
    170.8 KB · Views: 10
  • Cont data example.png
    Cont data example.png
    97.7 KB · Views: 10
  • Sols data example.png
    Sols data example.png
    93.4 KB · Views: 10
  • Summary example.png
    Summary example.png
    132.9 KB · Views: 10

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
You could upload your dummy document to the cloud, with correct headings, but with the expected results. That is, you must put all the formulas and the results of the formulas in the cells, so that I can analyze all the formulas and perform them in VBA.
The example, even a small one, should consider all the formulas so that the VBA code can be used in your complete base.

It would also be good, if in the summary sheet, you add comments on the operation of each formula (especially in the most complex ones.).

You could upload a copy of your file to a free site such www.dropbox.com or google drive. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.
 
Upvote 0
Format.xlsm

Above is the file including the formulas I have created. The calculations would need to follow the same pattern from Jan-21 until Mar-22.

I hope this helps.
 
Upvote 0
Hi Caty:

Review the following to see if it helps excel not crash.

1. We will keep the formulas in the range from C4 to AT26.
2. Run the macro to replicate columns A and B as many months as there are from Jan-21 to the present.
3. The macro will copy the formulas in blocks and replace the formulas with values. That way you won't have the formulas all the time. And you will have the updated values.

VBA Code:
Sub summary2()
  Dim shS As Worksheet
  Dim a3 As Variant, a4 As Variant
  Dim i As Long, j As Long, m As Long
  Dim nMonths As Long, nStart As Date
  Dim rng As Range
  
  Set shS = Sheets("Summary")
  Set rng = shS.Range("C4:AT26")
  'Construction
  shS.Range("A27:AT" & Rows.Count).ClearContents
  nStart = DateSerial(2021, 1, 1)
  nMonths = (Year(Date) - Year(nStart)) * 12 + Month(Date)
  a3 = shS.Range("A4:B26")
  ReDim a4(1 To nMonths * 23, 1 To 2)
  For i = 2 To nMonths
    For j = 1 To 23
      m = m + 1
      a4(m, 1) = a3(j, 1)
      a4(m, 2) = DateSerial(Year(nStart), i, 1)
    Next
  Next
  shS.Range("A27").Resize(UBound(a4, 1), 2).Value = a4
  
  j = 27
  For i = 1 To nMonths - 1
    With shS.Range("C" & j)
      rng.Copy .Cells(1)
      .Resize(23, 44).Value = .Resize(23, 44).Value
    End With
    j = j + 23
  Next
End Sub

Notes: I check the formulas and found the following for you to adjust in your formulas:
a) in cell S4 to Z4 it says $B$4, it should read $B4
b) You have this formula in cell K4
Excel Formula:
=SUM((SUMIFS('Clean Appointments'!$F:$F,'Clean Appointments'!$C:$C,"="&$A4,'Clean Appointments'!$E:$E,"="&$B4,'Clean Appointments'!$I:$I,"="&$K$2,'Clean Appointments'!$G:$G,"="&K$3)))

Maybe it could be:
Excel Formula:
=SUM((SUMIFS('Clean Appointments'!$F:$F,'Clean Appointments'!$C:$C,"="&$A4,'Clean Appointments'!$E:$E,"="&$B4,'Clean Appointments'!$I:$I,{"Cancelled";"No show"},'Clean Appointments'!$G:$G,"="&K$3)))

------
If you still have problems with excel, then we change all the formulas by processes in VBA.
 
Upvote 0
Hi, thanks for your help once again :)

This has worked wonderfully. Just as an addition how can we change all the formulas by processes in VBA?
 
Upvote 0
how can we change all the formulas by processes in VBA?

I was afraid you were going to ask that.
To replace all the formulas and the whole process is done in memory (which is the most efficient), a specific code must be made for each formula; I had already advanced a little, formulas from C to V. When I came up with the idea of copying formulas into blocks.

I present the advance, the formulas from the W to the TA are missing.

Run the following code on a copy of your book. The code will create all C4 - V4 values from January 2021 to March 2022. You just have to put the data from A4 to B26. And one more detail, the text "Scheduled" should go in cell C2, that way the pattern is maintained.
1648569882289.png


VBA Code:
Sub summary1()
  Dim shS As Worksheet
  Dim a As Variant, a2 As Variant, a3 As Variant, a4 As Variant
  Dim b As Variant, c As Variant, d As Variant
  Dim dic1 As Object, dic2 As Object, dic3 As Object
  Dim dic4 As Object, dic5 As Object, dic6 As Object
  Dim ky1 As String, ky2 As String, ky3 As String
  Dim ky4 As String, ky5 As String, ky6 As String
  Dim x_bran As String, x_date As String, x_type As String, x_stat As String
  Dim i As Long, j As Long, k As Long, m As Long, n As Long
  Dim nMonths As Long, nStart As Date
  Dim ky_x As Variant, ky_y As Variant, ky_z As Variant
  
  Set shS = Sheets("Summary")
  Set dic1 = CreateObject("Scripting.Dictionary")
  Set dic2 = CreateObject("Scripting.Dictionary")
  Set dic3 = CreateObject("Scripting.Dictionary")
  Set dic4 = CreateObject("Scripting.Dictionary")
  Set dic5 = CreateObject("Scripting.Dictionary")
  Set dic6 = CreateObject("Scripting.Dictionary")
  dic1.comparemode = vbTextCompare
  dic2.comparemode = vbTextCompare
  dic3.comparemode = vbTextCompare
  dic4.comparemode = vbTextCompare
  dic5.comparemode = vbTextCompare
  dic6.comparemode = vbTextCompare
  
  'Construction
  shS.Range("C4:V" & Rows.Count).ClearContents
  shS.Range("A28:A" & Rows.Count).ClearContents
  nStart = DateSerial(2021, 1, 1)
  nMonths = (Year(Date) - Year(nStart)) * 12 + Month(Date)
  a3 = shS.Range("A4:B26")
  ReDim a4(1 To nMonths * 23, 1 To 2)
  For i = 2 To nMonths
    For j = 1 To 23
      m = m + 1
      a4(m, 1) = a3(j, 1)
      a4(m, 2) = DateSerial(Year(nStart), i, 1)
    Next
  Next
  shS.Range("A27").Resize(UBound(a4, 1), 2).Value = a4
  
  'Inputs
  a = shS.Range("A1:V" & shS.Range("A" & Rows.Count).End(3).Row).Value2
  b = Sheets("Clean Appointments").Range("A2:I" & Sheets("Clean Appointments").Range("A" & Rows.Count).End(3).Row).Value2
  c = Sheets("Contributions").Range("A2:G" & Sheets("Contributions").Range("A" & Rows.Count).End(3).Row).Value2
  d = Sheets("Solutions").Range("A2:G" & Sheets("Solutions").Range("A" & Rows.Count).End(3).Row).Value2
  
  ReDim a2(1 To UBound(a, 1) - 3, 1 To UBound(a, 2) - 2)
  
  For i = 1 To UBound(b, 1)
    If b(i, 9) = "Cancelled" Or b(i, 9) = "No Show" Then b(i, 9) = "Cancelled"
    '1       2       3       4           5     6       7       8   9
    'Region  Market  Branch  Appointment Date  Volume  AppType AHT AppStatus
    ky1 = b(i, 1) & "|" & b(i, 5) & "|" & b(i, 7) & "|" & b(i, 9)
    ky2 = b(i, 2) & "|" & b(i, 5) & "|" & b(i, 7) & "|" & b(i, 9)
    ky3 = b(i, 3) & "|" & b(i, 5) & "|" & b(i, 7) & "|" & b(i, 9)
    
    dic1(ky1) = dic1(ky1) + b(i, 6)
    dic2(ky2) = dic2(ky2) + b(i, 6)
    dic3(ky3) = dic3(ky3) + b(i, 6)
  Next
  
  For i = 1 To UBound(d, 1)
    '1       2       3       4     5       6         7
    'Region  Market  Branch  Date  Volume  Category  AHT
    ky4 = d(i, 1) & "|" & d(i, 4) & "|" & d(i, 6)
    ky5 = d(i, 2) & "|" & d(i, 4) & "|" & d(i, 6)
    ky6 = d(i, 3) & "|" & d(i, 4) & "|" & d(i, 6)
    
    dic4(ky4) = dic4(ky4) + d(i, 5)
    dic5(ky5) = dic5(ky5) + d(i, 5)
    dic6(ky6) = dic6(ky6) + d(i, 5)
  Next
  
  k = 0
  For i = 4 To UBound(a, 1)
    n = n + 1
    k = k + 1
    m = 0
    x_bran = a(i, 1)
    x_date = a(i, 2)
    For j = 3 To UBound(a, 2)
      m = m + 1
      If a(2, j) <> "" Then x_stat = a(2, j)
      If x_stat = "Cancelled/No Show" Then x_stat = "Cancelled"
      x_type = a(3, j)
      ky_x = x_bran & "|" & x_date & "|" & x_type & "|" & x_stat
      ky_y = x_bran & "|" & x_date & "|" & x_type
      
      Select Case n
      Case Is < 16
        If dic3.exists(ky_x) Then a2(k, m) = dic3(ky_x) Else a2(k, m) = 0
        If j >= 19 And j <= 22 Then
          If dic6.exists(ky_y) Then a2(k, m) = dic6(ky_y) Else a2(k, m) = 0
        End If
      Case 16 To 19
        If dic2.exists(ky_x) Then a2(k, m) = dic2(ky_x) Else a2(k, m) = 0
        If j >= 19 And j <= 22 Then
          If dic5.exists(ky_y) Then a2(k, m) = dic5(ky_y) Else a2(k, m) = 0
        End If
      Case Is > 19
        If dic1.exists(ky_x) Then a2(k, m) = dic1(ky_x) Else a2(k, m) = 0
        If j >= 19 And j <= 22 Then
          If dic4.exists(ky_y) Then a2(k, m) = dic4(ky_y) Else a2(k, m) = 0
        End If
      End Select
    Next
    If n = 23 Then n = 0
  Next
  shS.Range("C4").Resize(UBound(a2, 1), UBound(a2, 2)).Value = a2
End Sub
 
Upvote 0
Hi Caty:

This is the complete macro to replace all formulas from A to AT and for all periods.

VBA Code:
Sub summary1()
  Dim shS As Worksheet
  Dim a As Variant, a2 As Variant, a3 As Variant, a4 As Variant
  Dim b As Variant, c As Variant, d As Variant
  Dim dic1 As Object, dic2 As Object, dic3 As Object
  Dim dic4 As Object, dic5 As Object, dic6 As Object
  Dim dic9 As Object
  Dim ky1 As String, ky2 As String, ky3 As String
  Dim ky4 As String, ky5 As String, ky6 As String
  Dim x_bran As String, x_date As String, x_type As String, x_stat As String
  Dim i As Long, j As Long, k As Long, m As Long, n As Long
  Dim nMonths As Long, nStart As Date
  Dim ky_x As Variant, ky_y As Variant, ky_z As Variant
  Dim valorc As Double, aht As Double
  
  Set shS = Sheets("Summary")
  Set dic1 = CreateObject("Scripting.Dictionary")
  Set dic2 = CreateObject("Scripting.Dictionary")
  Set dic3 = CreateObject("Scripting.Dictionary")
  Set dic4 = CreateObject("Scripting.Dictionary")
  Set dic5 = CreateObject("Scripting.Dictionary")
  Set dic6 = CreateObject("Scripting.Dictionary")
  Set dic9 = CreateObject("Scripting.Dictionary")
  dic1.comparemode = vbTextCompare
  dic2.comparemode = vbTextCompare
  dic3.comparemode = vbTextCompare
  dic4.comparemode = vbTextCompare
  dic5.comparemode = vbTextCompare
  dic6.comparemode = vbTextCompare
  dic9.comparemode = vbTextCompare
  
  'Construction
  shS.Range("A28:A" & Rows.Count).ClearContents
  nStart = DateSerial(2021, 1, 1)
  nMonths = (Year(Date) - Year(nStart)) * 12 + Month(Date)
  a3 = shS.Range("A4:B26")
  ReDim a4(1 To nMonths * 23, 1 To 2)
  For i = 2 To nMonths
    For j = 1 To 23
      m = m + 1
      a4(m, 1) = a3(j, 1)
      a4(m, 2) = DateSerial(Year(nStart), i, 1)
    Next
  Next
  shS.Range("A27").Resize(UBound(a4, 1), 2).Value = a4
  
  'Inputs
  shS.Range("C4:AT" & Rows.Count).ClearContents
  a = shS.Range("A1:AT" & shS.Range("A" & Rows.Count).End(3).Row).Value2
  b = Sheets("Clean Appointments").Range("A2:I" & Sheets("Clean Appointments").Range("A" & Rows.Count).End(3).Row).Value2
  c = Sheets("Contributions").Range("A2:G" & Sheets("Contributions").Range("A" & Rows.Count).End(3).Row).Value2
  d = Sheets("Solutions").Range("A2:G" & Sheets("Solutions").Range("A" & Rows.Count).End(3).Row).Value2
  
  ReDim a2(1 To UBound(a, 1) - 3, 1 To UBound(a, 2) - 2)
  
  'SUM Clean Appointments
  For i = 1 To UBound(b, 1)
    If b(i, 9) = "Cancelled" Or b(i, 9) = "No Show" Then b(i, 9) = "Cancelled"
    '1       2       3       4           5     6       7       8   9
    'Region  Market  Branch  Appointment Date  Volume  AppType AHT AppStatus
    ky1 = b(i, 1) & "|" & b(i, 5) & "|" & b(i, 7) & "|" & b(i, 9)
    ky2 = b(i, 2) & "|" & b(i, 5) & "|" & b(i, 7) & "|" & b(i, 9)
    ky3 = b(i, 3) & "|" & b(i, 5) & "|" & b(i, 7) & "|" & b(i, 9)
    
    dic1(ky1) = dic1(ky1) + b(i, 6)
    dic2(ky2) = dic2(ky2) + b(i, 6)
    dic3(ky3) = dic3(ky3) + b(i, 6)
    
    'AHT values
    dic9(b(i, 7)) = b(i, 8)
  Next
  
  'SUM Contributions
  For i = 1 To UBound(c, 1)
    '1       2       3       4     5       6         7
    'Region  Market  Branch  Date  Volume  Category  AHT
    ky4 = "c|" & c(i, 1) & "|" & c(i, 4) & "|" & c(i, 6)
    ky5 = "c|" & c(i, 2) & "|" & c(i, 4) & "|" & c(i, 6)
    ky6 = "c|" & c(i, 3) & "|" & c(i, 4) & "|" & c(i, 6)
    
    dic4(ky4) = dic4(ky4) + c(i, 5)
    dic5(ky5) = dic5(ky5) + c(i, 5)
    dic6(ky6) = dic6(ky6) + c(i, 5)
  Next
  
  'SUM Solutions
  For i = 1 To UBound(d, 1)
    '1       2       3       4     5       6         7
    'Region  Market  Branch  Date  Volume  Category  AHT
    ky4 = "s|" & d(i, 1) & "|" & d(i, 4) & "|" & d(i, 6)
    ky5 = "s|" & d(i, 2) & "|" & d(i, 4) & "|" & d(i, 6)
    ky6 = "s|" & d(i, 3) & "|" & d(i, 4) & "|" & d(i, 6)
    
    dic4(ky4) = dic4(ky4) + d(i, 5)
    dic5(ky5) = dic5(ky5) + d(i, 5)
    dic6(ky6) = dic6(ky6) + d(i, 5)
  Next
  
  k = 0
  For i = 4 To UBound(a, 1)
    n = n + 1
    k = k + 1
    m = 0
    x_bran = a(i, 1)
    x_date = a(i, 2)
    For j = 3 To UBound(a, 2)
      m = m + 1
      If a(2, j) <> "" Then x_stat = a(2, j)
      If x_stat = "Cancelled/No Show" Then x_stat = "Cancelled"
      x_type = a(3, j)
      ky_x = x_bran & "|" & x_date & "|" & x_type & "|" & x_stat
      
      'key Solutions
      ky_y = "s|" & x_bran & "|" & x_date & "|" & x_type
      
      'key Contributions
      ky_z = "c|" & x_bran & "|" & x_date & "|" & x_type
      
      Select Case n
      Case Is < 16
        If dic3.exists(ky_x) Then a2(k, m) = dic3(ky_x) Else a2(k, m) = 0
        If j >= 19 And j <= 22 Then If dic6.exists(ky_y) Then a2(k, m) = dic6(ky_y) Else a2(k, m) = 0
        If j >= 23 And j <= 26 Then If dic6.exists(ky_z) Then a2(k, m) = dic6(ky_z) Else a2(k, m) = 0
      Case 16 To 19
        If dic2.exists(ky_x) Then a2(k, m) = dic2(ky_x) Else a2(k, m) = 0
        If j >= 19 And j <= 22 Then If dic5.exists(ky_y) Then a2(k, m) = dic5(ky_y) Else a2(k, m) = 0
        If j >= 23 And j <= 26 Then If dic5.exists(ky_z) Then a2(k, m) = dic5(ky_z) Else a2(k, m) = 0
      Case Is > 19
        If dic1.exists(ky_x) Then a2(k, m) = dic1(ky_x) Else a2(k, m) = 0
        If j >= 19 And j <= 22 Then If dic4.exists(ky_y) Then a2(k, m) = dic4(ky_y) Else a2(k, m) = 0
        If j >= 23 And j <= 26 Then If dic4.exists(ky_z) Then a2(k, m) = dic4(ky_z) Else a2(k, m) = 0
      End Select
      
      aht = dic9(x_type)
      If j >= 27 And j <= 46 Then
        If j >= 35 Then valorc = a2(k, j - 22) Else valorc = a2(k, j - 26)
        a2(k, m) = valorc * (aht / 60 / 21 / 7 * 1.253)
      End If
      
    Next
    If n = 23 Then n = 0
  Next
  shS.Range("C4").Resize(UBound(a2, 1), UBound(a2, 2)).Value = a2
End Sub


Additionally I tell you, if you decide to continue with the first option, you must update the following formulas:
In cell AA19, must be $B$B
Excel Formula:
=SUM((SUMAIFS('Clean Appointments'!$F:$F,'Clean Appointments[B][COLOR=rgb(226, 80, 65)]'!$C:$C[/COLOR][/B],"="

In cell AA23, must be $A$A

The macro of this post already corrected the problems of the formulas.
 
Upvote 0

Forum statistics

Threads
1,214,386
Messages
6,119,216
Members
448,876
Latest member
Solitario

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
Back
Top