Function getValue(i, j)
getValue = Cells(i, j).Value
End Function
Sub setValue(i, j, target)
Cells(i, j) = target
End Sub
Sub EnquiryReport1()
reportdate = InputBox("Enter report month (e.g. 2023.04)")
Dim wb As Workbook
Dim FolderPath As String
Dim FilePath As String
FolderPath = "P:\DA\EAA Enquiry\" & reportdate & "\"
FilePath = Dir(FolderPath & "*.htm*")
Do While FilePath <> ""
Set wb = Workbooks.Open(FolderPath & FilePath)
FilePath = Dir
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
mergestart = 14
mergeend = 14
changetocolor = True
acdtype = getValue(3, 1)
If acdtype = "CC" Then
toSet = "Corporate Communications"
ElseIf acdtype = "Complaints" Then
toSet = "Operations"
ElseIf acdtype = "Exam" Then
toSet = "Examination"
ElseIf acdtype = "Licensing" Then
toSet = "Licensing"
ElseIf acdtype = "PD" Then
toSet = "Professional Development"
ElseIf acdtype = "Reception" Then
toSet = "Reception"
End If
If Right(reportdate, 2) = "01" Then
reportmonth = "Jan" & " " & Left(reportdate, 4)
ElseIf Right(reportdate, 2) = "02" Then
reportmonth = "Feb" & " " & Left(reportdate, 4)
ElseIf Right(reportdate, 2) = "03" Then
reportmonth = "Mar" & " " & Left(reportdate, 4)
ElseIf Right(reportdate, 2) = "04" Then
reportmonth = "Apr" & " " & Left(reportdate, 4)
ElseIf Right(reportdate, 2) = "05" Then
reportmonth = "May" & " " & Left(reportdate, 4)
ElseIf Right(reportdate, 2) = "06" Then
reportmonth = "Jun" & " " & Left(reportdate, 4)
ElseIf Right(reportdate, 2) = "07" Then
reportmonth = "Jul" & " " & Left(reportdate, 4)
ElseIf Right(reportdate, 2) = "08" Then
reportmonth = "Aug" & " " & Left(reportdate, 4)
ElseIf Right(reportdate, 2) = "09" Then
reportmonth = "Sep" & " " & Left(reportdate, 4)
ElseIf Right(reportdate, 2) = "10" Then
reportmonth = "Oct" & " " & Left(reportdate, 4)
ElseIf Right(reportdate, 2) = "11" Then
reportmonth = "Nov" & " " & Left(reportdate, 4)
ElseIf Right(reportdate, 2) = "12" Then
reportmonth = "Dec" & " " & Left(reportdate, 4)
End If
setValue 3, 1, "ACD Report of " & toSet & " (" & reportmonth & ")"
With Range("A11:A13")
.Merge
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
With Range("J11:J13")
.Merge
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
For i = 14 To lastrow
num = getValue(i, 1)
If Not num = "Total" Then
wordcheck = getValue(i, 10)
If InStr(wordcheck, "Can") Then
If InStr(wordcheck, "Practice") Then
setValue i, 10, "Practice - Cantonese"
Else
setValue i, 10, acdtype & " - Cantonese"
End If
End If
If Not IsEmpty(num) Then
For j = 1 To 9
With Range(Cells(mergestart, j), Cells(mergeend,
j))
.Merge
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Next j
If changetocolor Then
Range(Cells(mergestart, 1), Cells(mergeend,
15)).Interior.Color = RGB(255, 255, 255)
changetocolor = False
Else
Range(Cells(mergestart, 1), Cells(mergeend,
15)).Interior.Color = RGB(217, 217, 217)
changetocolor = True
End If
mergestart = i
mergeend = i
Else
mergeend = mergeend + 1
End If
End If
Next i
For i = lastrow - 2 To 14 Step -1
If getValue(i, 12) = 0 Then
Rows(i).Delete
lastrow = lastrow - 1
End If
Next i
Dim wboriginal As Excel.Workbook
Set wboriginal = ActiveWorkbook
Workbooks.Open "P:\DA\EAA Enquiry\formula.xls", , True
Range("A5:O6").Copy
wboriginal.Activate
Range(Cells(lastrow - 1, 1), Cells(lastrow, 15)).PasteSpecial
Paste:=xlPasteFormulasAndNumberFormats, operation:=xlNone, SkipBlanks:=False,
Transpose:=False
Range(Cells(lastrow - 1, 1), Cells(lastrow, 15)).PasteSpecial
Paste:=xlPasteFormats, operation:=xlNone, SkipBlanks:=False, Transpose:=False
Workbooks("formula.xls").Close savechanges:=False
Cells.Select
With Selection.Font
.Name = "Calibri"
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Columns("B:O").Select
Columns("B:O").EntireColumn.AutoFit
saveasfilename = getValue(3, 1)
saveaspath = "P:\DA\EAA Enquiry\" & reportdate & "\ACD\" &
saveasfilename
ActiveWorkbook.SaveAs Filename:=saveaspath, FileFormat:=51
ActiveWorkbook.Close savechanges:=False
Loop
End Sub
