Scribd
Upload
9 views4 pages

Generate ACD Report

The document contains a VBA script for generating an enquiry report based on user input for a specific month. It processes HTML files from a designated folder, categorizes data based on specific criteria, and formats the report accordingly. Finally, it saves the report in a specified directory with the appropriate filename and format.

Uploaded by

040601is
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
9 views4 pages

Generate ACD Report

The document contains a VBA script for generating an enquiry report based on user input for a specific month. It processes HTML files from a designated folder, categorizes data based on specific criteria, and formats the report accordingly. Finally, it saves the report in a specified directory with the appropriate filename and format.

Uploaded by

040601is
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
You are on page 1/ 4

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

You might also like

pFad - Phonifier reborn

Pfad - The Proxy pFad of © 2024 Garber Painting. All rights reserved.

Note: This service is not intended for secure transactions such as banking, social media, email, or purchasing. Use at your own risk. We assume no liability whatsoever for broken pages.


Alternative Proxies:

Alternative Proxy

pFad Proxy

pFad v3 Proxy

pFad v4 Proxy