Dim ufDic As Object
Private Const cStepCount As Integer = 27 ' <<< step 0 is start of process and should not be counted
Public iStepCurrent As Integer
Private siProgressPart As Single
Private siProgressALL As Single
Function GetFiles(sPath As String) As Variant
Dim sFileName As String
With CreateObject("Scripting.Dictionary")
sFileName = Dir(sPath, vbNormal)
Do While Not sFileName = vbNullString
.Item(sFileName) = Empty
sFileName = Dir
Loop
GetFiles = .Keys
End With
End Function
Private Sub Cleared_Click()
Unload Me
NightAuditP.Show
End Sub
Private Sub ListBox1_Click()
Me.Label2.Caption = ufDic(Me.ListBox1.Value)
Me.TextBox1 = "Save Reports to this address:" & vbNewLine & "G:\Shared drives\437 - HIE Malvern - All Users\Front desk\Night Audit\Audit Reports\Disembodied\" & Format(Date - 1, "mm-dd-yyyy")
End Sub
Private Sub retry_Click()
Unload Me
NightAuditP.Show
Missing.Show
End Sub
Private Sub Scan2_Click()
Call scn
Me.Scan2.Visible = False
NightAuditP.Scan.Visible = False
End Sub
Private Sub UserForm_Activate()
iStepCurrent = NightAuditP.iStepCurrent
Select Case iStepCurrent
Case 15 Or 16
Call Me.CK2
Case 6 Or 7
Call CK1
End Select
If Me.ListBox1.ListCount > 0 Then
Me.Cleared.Enabled = False
End If
End Sub
Sub CK1()
Dim DirectoryListArray As Variant, sPath As String
Dim rg As Range, i As Long, j As Long
sPath = ""
DirectoryListArray = GetFiles(sPath)
Set rg = Worksheets("Data List").Cells(1, 1).CurrentRegion
Set ufDic = CreateObject("Scripting.Dictionary")
For j = 2 To rg.Rows.Count
If Not rg.Cells(j, 6) = vbNullString Then
If UBound(Filter(DirectoryListArray, rg.Cells(j, 6), 1, 1)) < 0 Then
ufDic.Item(rg.Cells(j, 3).Value) = rg.Cells(j, 8).Value
End If
End If
Next j
Me.ListBox1.List = ufDic.Keys 'Adapt to your needs
Me.Show
End Sub
Sub CK2()
Dim DirectoryListArray As Variant, sPath As String
Dim rg As Range, i As Long, j As Long
sPath = ""
DirectoryListArray = GetFiles(sPath)
Set rg = Worksheets("Data List").Cells(1, 1).CurrentRegion
Set ufDic = CreateObject("Scripting.Dictionary")
For j = 2 To rg.Rows.Count
If Not rg.Cells(j, 7) = vbNullString Then
If UBound(Filter(DirectoryListArray, rg.Cells(j, 7), 1, 1)) < 0 Then
ufDic.Item(rg.Cells(j, 3).Value) = rg.Cells(j, 8).Value
End If
End If
Next j
Me.ListBox1.List = ufDic.Keys 'Adapt to your needs
Me.Show
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
Cancel = True
End If
End Sub