Dynamic File List and Create Table

[railon42]

Hello,

I am beginner to excel vba.

I have a task that performs listing the all files in specific folder(including subfolders) and create table depending on the size of data. I have 14 columns to fill. The first 8 column headers include information about file name, revision code, document name, extension, document create date, File Link, and document size. Other headers will be filled manually. There are three buttons in the excel Update table, search, and clear. Search button performs advanced filtering, Clear button performs clearing the contents of A1:D2 cells. Update table get files from file and if a new file added to the folder the data is updated.

Files in the folder must be similar name format. (XX-YYYY-ZZZZ_documentnumber_revisionnumber or XXXX-YYYY-ZZZZ_documentnumber_revisionnumber)

Also, there is an advanced filter table which filters the data in the table.

I have an issue with when a file added in the folder the columns that manually filled is shifted. Because last uploaded file is inserted random row between old file list. I want the files that last uploaded to the folder inserted at first empty row of the end of the filled row so that the columns that filled manually will not be shifted. Also create the table depending on the size of the rows.(column number are specified as 14.) The code is below:

Sub ListFiles()
    Application.ScreenUpdating = False
    Dim path As String
    path = "" 'Definition of the path
    Range("A8:H100000").ClearContents
   
    Cells(8, 1).Resize(, 14).Value = Array("Stock Number", "Document Code", "Revision Code", "Extension", "File Path", "Document Date", "File Link", "Document Size(KB)", "Customer", "Waiting Change Number", "Change Decision Number", " Prepared by", "Changed by", "Form number") 'Table title decleration on 5th Row
    Call GetFiles(path) ' Call GetFiles function
    Columns.EntireColumn.AutoFit
    Range("E:E").EntireColumn.Hidden = True
   
End Sub

Private Sub GetFiles(ByVal path As String)
    Application.ScreenUpdating = False
    Dim FSO As Object, Fldr As Object, subF As Object, file As Object, extn As String, rng As Range
    Dim Customer As String, wait_number As String, change_number As String, prepared As String, changed As String, form_number As String
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Fldr = FSO.GetFolder(path)
    For Each subF In Fldr.Subfolders
        GetFiles (subF.path)
    Next subF
   
    For Each file In Fldr.Files
       
        On Error Resume Next
        extn = Right(file.Name, Len(file.Name) - InStrRev(file.Name, "."))
        extn_name = Left(file.Name, Len(file.Name) - (Len(extn) + 1))
        dcmnt_rev = Right(extn_name, Len(extn_name) - InStrRev(extn_name, "_"))
        trim2 = Right(extn_name, Len(extn_name) - InStr(extn_name, "_"))
        dcmnt_code = Left(trim2, Len(trim2) - (Len(trim2) - InStr(trim2, "_") + 1))
        my_size = Round(FileLen(file.path) / 1024)
        file_date = FileDateTime(file.path)
       
        If Err.Number = 0 Then Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(, 8) = Array(extn_name, dcmnt_code, dcmnt_rev, extn, file.path, file_date, , my_size, Customer, wait_number, change_number, prepared, changed, form_number)
        On Error GoTo 0
       
       
    Next file

    Call CreateTable
    Set FSO = Nothing
    Set Fldr = Nothing
    Set subF = Nothing
    Set file = Nothing
End Sub
Private Sub Workbook_Open()
    Dim MyErrorCheckValue As Boolean
    MyErrorCheckValue = Application.ErrorCheckingOptions.NumberAsText
    Application.ErrorCheckingOptions.NumberAsText = False
End Sub

Private Sub CreateTable()
    Dim X As Integer
    Range("E:E").EntireColumn.Hidden = True
    lastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "E").End(xlUp).Row
    lastcolumn = 14
   
    Set rng = Range("A8", ActiveSheet.Cells(lastRow, lastcolumn))
    lastRow = 8
    On Error Resume Next
   
    Sheet1.ListObjects.Add(xlSrcRange, rng, , xlYes).Name = "Table1"
    Range("B8", ActiveSheet.Cells(lastRow, 6)).HorizontalAlignment = xlCenter
    Columns("A:D").NumberFormat = "@"
    rng.Rows.EntireRow.AutoFit
   
    For i = 9 To lastRow
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 7), Address:=Cells(i, 5).Text, TextToDisplay:=Cells(i, 1).Text
        With Cells(i, 7).Font
            .Strikethrough = False
            .Superscript = False
            .Underline = xlUnderlineStyleNone
        End With
    Next i
   
End Sub

Sub Search()

Range("Table1[#All]").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("A1:D2"), Unique:=False

End Sub

Sub ClearFilter()

Range("A2:D2").ClearContents
ActiveSheet.Range("A5").Select

Call Search

End Sub