Audit plan for next 3Yrs : Mark X based on audit frequency and previous audit quarter

[anish.ms]

Hi Everyone!


May I ask some help in the following problem. :help


I am working on a risk based internal audit plan for the next 3 years from 2021 to 2024.
In the attached worksheet, I have the area to be audited and its audit frequency based on the risk rating. I have done the coding up to this stage. I need your help in the following -
mark "X" in the respective year and quarter based on the audit frequency and previous audit month

Audit frequency (column I) - 1 means every year, 2 means twice in three years and 3 means once in 3 years; considering the previous audit month. If previous audit month is empty, then it has to be considered in the Q1 2021-22 and thereafter based on the audit frequency.

Currently I have marked X manually in columns L to W
Q1 is April to June and Q4 is January to March

Thanks in advance

[anish.ms]

Hi Everyone!

Please consider the revised file attached here.

I am working on a risk based internal audit plan for the next 3 years from financial year 2021-22 to 2023-24.
In the attached worksheet, I have the area to be audited and its audit frequency based on the risk rating. I have done the coding up to this stage.

I request your help in the following -
Capture Quarter (Q1/Q2/Q3/Q4) in the respective year based on the audit frequency and previous audit quarter and year

Audit frequency (column I) - 1 means every year, 2 means twice in three years and 3 means once in 3 years; considering the previous audit year. If previous audit year is empty, then it has to be considered in the Q1 2021-22 and thereafter based on the audit frequency.

Currently I have captured quarters manually in columns L to N
Q1 stand for April to June and Q4 January to March

For example, for an area if the last audit month is Nov-2020 and the audit frequency is 2. That means it is previously audited in Q3 FY 2020-21 and for the next 3 years plan, this area will be covered in Q3 FY 2022-23


Thanks in advance

[SamT]

Annual Quarters are arbitrarily defined, so start by defining the (Begin) date of your particular Quarters, starting in a year before any years you are interested in

For Ex:

Dim Q0B As Date 'Q0 for Standard Fiscal Start date, B for "Begin"
Q0B = DateSerial(2018, 04, 21) 'A universal Date Format that starts at 00:00:00 on that date
'So, if you do Quarter End dates, use
'Q0E = DateSerial(2018, 07, 21) + TimeSerial(23, 59, 59)

'The rest use DateAdd so only one Magic Number is used

Q1B18 = Q0B
Q2B18 = DateAdd("q", 1, Q1B)
Q3B18 = DateAdd("q", 1, Q2B)
Q4B18 = DateAdd("q", 1, Q3B)


By using DateAdd it is easy to covert any Quarter variable to any year
For Ex:

Dim Q1B21 As Date
Q1B21 = DateAdd("y", 3, Q0B)

[Paul_Hossler]

This seems to work. Little bit brute force



Option Explicit


Sub Audits()
Dim r As Range
Dim iRow As Long, iQtr As Long, iYear As Long, iMonth As Long, iFreq As Long, iAudit As Long, iIncrement As Long
Dim aryAudits(12 To 23) As Date, aryNextAudits(1 To 4)
Dim LastAudit As Date

Application.EnableEvents = False

aryAudits(12) = DateSerial(2021, 4, 1)
For iQtr = LBound(aryAudits) + 1 To UBound(aryAudits)
aryAudits(iQtr) = DateAdd("q", 1, aryAudits(iQtr - 1))
Next iQtr

Set r = Worksheets("Audit Plan").Range("a1").CurrentRegion


' 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
'Audit Frequency Mandays Required Previous Audit Month Q1 Q2 Q3 Q4 Q1 Q2 Q3 Q4 Q1 Q2 Q3 Q4
r.Cells(3, 12).Resize(r.Rows.Count - 2, 12).ClearContents

With r
'down all data rows
For iRow = 3 To .Rows.Count


'make last audit start on first day of quarter
If Len(.Cells(iRow, 11).Value) = 0 Then
iYear = 2021
iMonth = 4
Else
iYear = Year(.Cells(iRow, 11).Value)
iMonth = Month(.Cells(iRow, 11).Value)
End If

Select Case iMonth
Case 1 To 3
LastAudit = DateSerial(iYear, 1, 1)
Case 4 To 6
LastAudit = DateSerial(iYear, 4, 1)
Case 7 To 9
LastAudit = DateSerial(iYear, 7, 1)
Case 10 To 12
LastAudit = DateSerial(iYear, 10, 1)
End Select


'select audit freq
iIncrement = .Cells(iRow, 9).Value

Erase aryNextAudits

If Year(LastAudit) <= 2020 Then
LastAudit = DateAdd("yyyy", 1, LastAudit)

ElseIf Year(LastAudit) = 2021 And Month(LastAudit) = 1 Then
LastAudit = DateAdd("yyyy", iIncrement, LastAudit)
End If

If iIncrement > 0 Then
aryNextAudits(1) = LastAudit
aryNextAudits(2) = DateAdd("yyyy", iIncrement, aryNextAudits(1))
aryNextAudits(3) = DateAdd("yyyy", iIncrement, aryNextAudits(2))
aryNextAudits(4) = DateAdd("yyyy", iIncrement, aryNextAudits(3))
End If


For iFreq = LBound(aryNextAudits) To UBound(aryNextAudits)
For iAudit = LBound(aryAudits) To UBound(aryAudits)
If aryNextAudits(iFreq) = aryAudits(iAudit) Then
.Cells(iRow, iAudit).Value = "X"
End If
Next iAudit
Next iFreq

Next iRow

End With


Application.EnableEvents = True


End Sub

[anish.ms]

Thanks Sam for your response

[anish.ms]

Thanks a ton Paul!
Oh! you seem to worked on my first uploaded version of the file.
Sorry for the confusion; I couldn't find the option to delete first message.

In the latest version I changed the quarter wise headings to just financial years and instead of 'X' mark the quarters

I tried to change the code to fit in my revised version of the file; but it seems something is going wrong.
Could you please help me?
Sorry to bother you again.


Option Explicit

Sub Audits()
Dim r As Range
Dim iRow As Long, iQtr As Long, iYear As Long, iMonth As Long, iFreq As Long, iAudit As Long, iIncrement As Long
Dim aryAudits(12 To 14) As Date, aryNextAudits(1 To 4)
Dim LastAudit As Date
Dim iM As Long, iQ As String


Application.EnableEvents = False

aryAudits(12) = DateSerial(2021, 4, 1)
For iQtr = LBound(aryAudits) + 1 To UBound(aryAudits)
aryAudits(iQtr) = DateAdd("YYYY", 1, aryAudits(iQtr - 1))
Next iQtr

Set r = Worksheets("Audit Plan").Range("a1").CurrentRegion

' 9 10 11 12 13 14
'Audit Frequency Mandays Required Previous Audit Month FY 2021-22 FY 2022-23 FY 2023-24
r.Cells(3, 12).Resize(r.Rows.Count - 2, 3).ClearContents

With r
'down all data rows
For iRow = 3 To .Rows.Count


'make last audit start on first day of quarter
If Len(.Cells(iRow, 11).Value) = 0 Then
iYear = 2021
iMonth = 4
Else
iYear = Year(.Cells(iRow, 11).Value)
iMonth = Month(.Cells(iRow, 11).Value)
End If

Select Case iMonth
Case 1 To 3
LastAudit = DateSerial(iYear, 1, 1)
Case 4 To 6
LastAudit = DateSerial(iYear, 4, 1)
Case 7 To 9
LastAudit = DateSerial(iYear, 7, 1)
Case 10 To 12
LastAudit = DateSerial(iYear, 10, 1)
End Select


'select audit freq
iIncrement = .Cells(iRow, 9).Value

Erase aryNextAudits

If Year(LastAudit) <= 2020 Then
LastAudit = DateAdd("yyyy", iIncrement, LastAudit)

ElseIf Year(LastAudit) = 2021 And Month(LastAudit) = 1 Then
LastAudit = DateAdd("yyyy", iIncrement, LastAudit)
End If

If iIncrement > 0 Then
aryNextAudits(1) = LastAudit
aryNextAudits(2) = DateAdd("yyyy", iIncrement, aryNextAudits(1))
aryNextAudits(3) = DateAdd("yyyy", iIncrement, aryNextAudits(2))
aryNextAudits(4) = DateAdd("yyyy", iIncrement, aryNextAudits(3))
End If

For iFreq = LBound(aryNextAudits) To UBound(aryNextAudits)
For iAudit = LBound(aryAudits) To UBound(aryAudits)
If Year(aryNextAudits(iFreq)) = Year(aryAudits(iAudit)) Then
iM = Month(aryNextAudits(iFreq))
Select Case iM
Case 1 To 3
iQ = "Q4"
Case 4 To 6
iQ = "Q1"
Case 7 To 9
iQ = "Q2"
Case 10 To 12
iQ = "Q3"
End Select
.Cells(iRow, iAudit).Value = iQ
End If
Next iAudit
Next iFreq

Next iRow

End With

Application.EnableEvents = True

End Sub

[Paul_Hossler]

OK -- try this version

On the attachment the gray areas are just some test data (your answers and if they match my macro)



Option Explicit


Sub Audits()
Dim r As Range
Dim iRow As Long, iQtr As Long, iYear As Long, iMonth As Long, iFreq As Long, iAudit As Long, iIncrement As Long
Dim aryAudits(1 To 12) As Date, aryNextAudits(1 To 8) As Date
Dim LastAudit As Date
Dim sQtr As String

Application.EnableEvents = False

aryAudits(1) = DateSerial(2021, 4, 1)
For iQtr = LBound(aryAudits) + 1 To UBound(aryAudits)
aryAudits(iQtr) = DateAdd("q", 1, aryAudits(iQtr - 1))
Next iQtr

Set r = Worksheets("Audit Plan").Range("a1").CurrentRegion


' 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
'Audit Frequency Mandays Required Previous Audit Month Q1 Q2 Q3 Q4 Q1 Q2 Q3 Q4 Q1 Q2 Q3 Q4

r.Cells(3, 12).Resize(r.Rows.Count - 2, 3).ClearContents

With r
'down all data rows
For iRow = 3 To .Rows.Count

'select audit freq
iIncrement = .Cells(iRow, 9).Value

If iIncrement = 0 Then GoTo NextRow


If iRow = 9 Then Stop


'make last audit start on first day of quarter
If Len(.Cells(iRow, 11).Value) = 0 Then
iYear = 2021
iMonth = 4
Else
iYear = Year(.Cells(iRow, 11).Value)
iMonth = Month(.Cells(iRow, 11).Value)
End If

Select Case iMonth
Case 1 To 3
LastAudit = DateSerial(iYear, 1, 1)
Case 4 To 6
LastAudit = DateSerial(iYear, 4, 1)
Case 7 To 9
LastAudit = DateSerial(iYear, 7, 1)
Case 10 To 12
LastAudit = DateSerial(iYear, 10, 1)
End Select

' 'look back since some audits are old
If LastAudit = DateSerial(2021, 1, 1) Then
LastAudit = DateAdd("yyyy", iIncrement + 1, LastAudit)
End If

'build list of possible audit dates
Erase aryNextAudits

aryNextAudits(LBound(aryNextAudits)) = LastAudit
For iFreq = LBound(aryNextAudits) + 1 To UBound(aryNextAudits)
aryNextAudits(iFreq) = DateAdd("yyyy", iIncrement, aryNextAudits(iFreq - 1))
Next iFreq

For iFreq = LBound(aryNextAudits) To UBound(aryNextAudits)
For iAudit = LBound(aryAudits) To UBound(aryAudits)
If aryNextAudits(iFreq) = aryAudits(iAudit) Then
iYear = Year(aryNextAudits(iFreq))
iMonth = Month(aryNextAudits(iFreq))

Select Case iMonth
Case 1 To 3
sQtr = "Q4"
Case 4 To 6
sQtr = "Q1"
Case 7 To 9
sQtr = "Q2"
Case 10 To 12
sQtr = "Q3"
End Select

Select Case iYear
Case 2021
.Cells(iRow, 12).Value = sQtr

Case 2022
If sQtr = "Q4" Then
.Cells(iRow, 12).Value = sQtr
Else
.Cells(iRow, 13).Value = sQtr
End If

Case 2023
If sQtr = "Q4" Then
.Cells(iRow, 13).Value = sQtr
Else
.Cells(iRow, 14).Value = sQtr
End If

Case 2024
If sQtr = "Q4" Then
.Cells(iRow, 14).Value = sQtr
Else
.Cells(iRow, 15).Value = sQtr
End If
End Select

End If
Next iAudit
Next iFreq


NextRow:
Next iRow

End With


Application.EnableEvents = True


End Sub

[anish.ms]

Thanks a ton Paul!
Hope the below part of the code was for testing

If iRow = 9 Then Stop
The highlighted dates were not giving the expected results. Basically for the Feb-2021 previous audit with frequency of 1, 3 year plan should be Q4 in all 3 years (to be audited every year in the same qtr of previous audit)
Same way, if the frequency is 2, it should be Q4 only in FY 2022-23 (to be audited once in alternate years in the same qtr of previous audit)
Audit frequency is the gap required from previous audit. If previous audit is blank then it will be considered in the Q1 of FY 2021-22 and there after based on the audit frequency

So I removed +1 from below part of the code

If LastAudit = DateSerial(2021, 1, 1) Then
LastAudit = DateAdd("yyyy", iIncrement + 1, LastAudit)
End If

It is working fine except some cases as we are not considering the gap between previous audit and audit frequency in the code
For example, if the audit frequency is 2 and last audit is Oct-2018 (FY 2018-19), ideally it should be considered in Q1 of FY 2021-22.

I need to include the following in the codes -


If iIncrement = 2 And LastAudit < DateSerial(2019, 4, 1) Then
LastAudit = DateSerial(2019, 4, 1)
End If

If iIncrement = 3 And LastAudit < DateSerial(2018, 4, 1) Then
LastAudit = DateSerial(2018, 4, 1)
End If

[Paul_Hossler]

1. Yes, it was for testing and I forgot to delete it

2. I wasn't sure about your business rules so I tried to derive them based on your data

3. If you make your changes, does it work for you?

[anish.ms]

3. Good question. I'm able to make small changes and it seems the said changes are working fine.
Thanks a lot Paul for your help!