Results 1 to 2 of 2

Thread: Cross Referencing Filenames Using an ID and "Charting" Results Across Columns

  1. #1
    VBAX Regular
    Jul 2019

    Post Cross Referencing Filenames Using an ID and "Charting" Results Across Columns

    Hey Everyone,

    I've been working on this project as my first attempt at VBA. It's coming together, thanks to help from you all, and 3 books I bought.

    Below is a screenshot of how I see it looking when it is cross-referencing the files and "charting" the data across the next 12 columns. Columns E-P; each of the 12 columns representing a month in the year.


    The green boxes represent audits that exist and an X (which would link to the actual file) and the red are ones that do not exist. It would only check out to the current month of this year to try to limit how much the program has to do.

    The example file names are like so...

    SOP-JV-001-CHL-Letter Lock for Channel Letters-EN.docx (Filename being broken down and displayed in Cols A-D)

    SOP_Audit-JV-001-082319.docx (files being cross-referenced with above files, using the ID in bold to determine if that audit belongs with that SOP)

    Here is the code I have so far...

    Option Explicit
    Private Sub Workbook_Open()
    '   Set local folder path
        Const FolderPath As String = "\\jacksonville-dc\common\test\SOPs With New Names"
        Const FileExt As String = "docx"
        Dim oFSO As Object
        Dim oFolder As Object
        Dim oFiles As Object
        Dim oFile As Object
        Set oFSO = CreateObject("Scripting.FileSystemObject")
        Set oFolder = oFSO.GetFolder(FolderPath)
        Set oFiles = oFolder.Files
        Dim v As Variant
        Dim iSheet As Long
    '   Clear Worksheets
        Dim ws As Worksheet
        For Each ws In ThisWorkbook.Worksheets
        Next ws
        For Each oFile In oFiles
            If LCase(Right(oFile.Name, 4)) = FileExt Then
                v = Split(oFile.Name, "-")
                Select Case v(3)
                    'Setup Select to determine dept values
                    Case "PNT", "VLG", "SAW"
                        Call pvtPutOnSheet(oFile.Path, 1, v)
                    Case "CRT", "AST", "SHP", "SAW"
                        Call pvtPutOnSheet(oFile.Path, 2, v)
                    Case "CRT", "STW", "CHL", "ALG", "ALW", "ALF", "RTE", "AFB", "SAW"
                        Call pvtPutOnSheet(oFile.Path, 3, v)
                    Case "SCR", "THR", "WSH", "GLW", "PTR", "SAW"
                        Call pvtPutOnSheet(oFile.Path, 4, v)
                    Case "PLB", "SAW"
                        Call pvtPutOnSheet(oFile.Path, 5, v)
                    Case "DES"
                        Call pvtPutOnSheet(oFile.Path, 6, v)
                    Case "AMS"
                        Call pvtPutOnSheet(oFile.Path, 7, v)
                    Case "EST"
                        Call pvtPutOnSheet(oFile.Path, 8, v)
                    Case "PCT"
                        Call pvtPutOnSheet(oFile.Path, 9, v)
                    Case "PUR", "INV"
                        Call pvtPutOnSheet(oFile.Path, 10, v)
                    Case "SAF"
                        Call pvtPutOnSheet(oFile.Path, 11, v)
                    Case "GEN"
                        Call pvtPutOnSheet(oFile.Path, 12, v)
                End Select
            End If
        Next oFile
    End Sub
    'Take a folder with files in it that use this naming structure: "SOP-JV-001-CHL-Letter Lock for Channel Letters-EN"
    'Split up that filename using the "-" as the delimiter
    'Filename[2] would go into COL A
    'Filename[3] would go into COL B
    'Filename[4] would go into COL C as a Hyperlink to the physical file
    'Filename[5] would go into COL D
    '000 11 222 333 4444444444444444444444444444444 55
    'SOP-JV-001-CHL-Letter Lock for Channel Letters-EN
    Private Sub pvtPutOnSheet(sPath As String, i As Long, v As Variant)
        Dim r As Range
        With Worksheets(i)
            Set r = .Cells(.Rows.Count, 1).End(xlUp)
            If Len(r.Value) > 0 Then Set r = r.Offset(1, 0)     '   next empty cell in Col A
            If UBound(v) > 3 Then
                r.Value = v(2)              '   Col A = "001"
                r.Offset(0, 1).Value = v(3) '   Col B = "CHL"
                'Create hyperlink in each cell
                .Hyperlinks.Add Anchor:=r.Offset(0, 2), Address:=sPath, TextToDisplay:=v(4) '   Col C = "Letter Lock for Channel Letters" with link to Path
                r.Offset(0, 3).Value = v(5) '   Col = "EN"
            End If
        End With
    End Sub
    Any suggestions would be welcome in all regards...

    Should this be a new Sub Procedure? What would be the most efficient method to make sure the file isn't incredibly slow; can Excel handle this much?

    Thank you to everyone.

  2. #2
    VBAX Regular
    Jul 2019
    These are just some comments, trying to lay out how the code will function, what do you think?

    Private Sub chkAuditDates()
        'Set path to audits
        Const FolderPath As String = "\\jacksonville-dc\common\test\SOP Audits with New Names"
        'Store values in COL A as a range called SOP IDs
        'Loop through each file
            'Break filename apart with Split(); looking for SOP ID and the Date
            'Loop through each cell in range: "SOP IDs" to see if cell value matches SOP ID in audit filename (Filename(2))
                'If there is a match, use the month in the date in Filename(3), to determine which Column to put the link in (E-P:Jan-Dec)
                'Use Offset() from the COL A cell being used to insert the link
    End Sub

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts