macro help

Jake975

Board Regular
Joined
Feb 9, 2020
Messages
101
Office Version
  1. 2016
Platform
  1. Windows
1605409351208.png

I need help creating a macro that checks if files exist. I will do my best to explain what is happing and what i need to happen.
column A is just the values in the name that are constant
column B is just and example of the file that gets saved (this column is just a reminder)
column C is what the file names get changed to
Column D is the order they will end up in a pdf
column F&G Are the files that need checked so during check1 im looking for those files(F) and check2 the files in (G)
the last bit of information is the list of files in the folder that i need to look at.
I can only match part of the file names as the rest are not static.
what i need the macro to do: look at the current folder and compare the list of files to the ones in column F. If a file is missing I need it to show the name from column C(corresponding Name) in a listbox of a userform.
For example if looking in folder "XPT" a file called "creditcard_history378494855.pdf" appears it would not display in the list but if it found no file with the partial name "creditcard_" then the list would display "Credit Card History.pdf".
It needs to display these values in a userform listbox NOT in a sheet.
VBA Code:
Sub TestFiles()

    Dim myfile As String, counter As Long
    Dim f As Long, Cel As Range
    Dim fName As String, cName As String
    Dim ws As Worksheet, temp As Worksheet, rng As Range
    Dim DirectoryListArray() As String
    ReDim DirectoryListArray(1000)
'Loop through all the files in the directory by using Dir$ function
    myfile = Dir$("C:\Audit Reports\Disembodied\10-14-2020\*.*")

Do While myfile <> ""
    DirectoryListArray(counter) = myfile
    myfile = Dir$
    counter = counter + 1
Loop

'Reset the size of the array without losing its values by using Redim Preserve
    ReDim Preserve DirectoryListArray(counter - 1)

'where is the list
    Set ws = Sheets("Data List")
    Set rng = ws.Range("A2", ws.Range("A" & ws.Rows.Count).End(xlUp))

'insert sheet for results
    Set temp = Sheets.Add(before:=Sheets(1))
    temp.Range(rng.Address).Value = rng.Value
    Set rng = temp.Range(rng.Address)
Dim arr()
Dim s As Integer
ReDim arr(1 To 10000)
t = 1

'check for items in sheet list not in folder
    rng.Offset(, 1).Value = "NotFound"
For Each Cel In rng
            Do Until f > UBound(DirectoryListArray)
                  cName = LCase(Cel)
                  fName = LCase(Left(DirectoryListArray(f), Len(Cel)))
                  If cName = fName Then
                           arr(t) = cName
                           t = t + 1
                           Exit Do
                  End If
                  f = f + 1
            Loop
    Next Cel
ReDim Preserve arr(1 To t - 1)
ListBox1.List = Application.Transpose(arr)
'listbox1:your listbox name
End Sub
This is what I have gotten together so far but it displays nothing
I know some of the code is wrong as i was trying to convert the sheet setup i kept getting from people to the setup i needed.
Any help would be grateful
 

Some videos you may like

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.

Jake975

Board Regular
Joined
Feb 9, 2020
Messages
101
Office Version
  1. 2016
Platform
  1. Windows
revision I did get help to get all the correct names to show up but it is listing the files already there how do I get it to show only the missing files?
Here is the macro Im using
VBA Code:
Sub MatchingValues()
    Dim DirectoryListArray As Variant, sPath As String
    Dim rg As Range, i As Long, j As Long
    Dim ListBox1 As Variant
    
    sPath = "C:\Users\test\Desktop\auto\"
    DirectoryListArray = GetFiles(sPath)
    
    Set rg = Worksheets("Data List").Cells(1, 1).CurrentRegion
    With CreateObject("Scripting.Dictionary")
        For i = 0 To UBound(DirectoryListArray)
            For j = 2 To rg.Rows.Count
                If Not rg.Cells(j, 6) = vbNullString Then
                    If InStr(1, DirectoryListArray(i), rg.Cells(j, 6)) > 0 Then
                        .Item(rg.Cells(j, 3).Value) = Empty
                    End If
                End If
            Next j
        Next i
        ListBox1 = .Keys
    End With
    
    MsgBox Join(ListBox1, vbLf)                   'Adapt to your needs
    
End Sub


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
I just need the list to show the missing files. any help would be grateful
 

Watch MrExcel Video

Forum statistics

Threads
1,118,800
Messages
5,574,399
Members
412,590
Latest member
Velly
Top