Hi All,

Background: In have input tab, when add to database is clicked in the input tab, information is saved in the last available row in "tracker", and in a file is saved as a result into C:\\tracker.

Wondering if you can help me to modify the code and return "yes" or "no" in a workbook.

- I would like to search for 12345_A.pdf in C:\\PDF and for 12345_A.igs in C:\\CNC Program folder. Not to mentioned, PDF folder and CNC programe folder has further 3 sub-folder "archive", "WIP" and "released" folder to be searched for.

- I would like to search these sub-folders for the criteria "12345_A.pdf &12345_A.igs" return "yes" or "no" in cell "h12" for PDF and "yes" or "no" for CNC program of the file.

Option Explicit

Sub UpdateLogWorksheet()

Tracker (1).xls    Dim historyWks As Worksheet
    Dim inputWks As Worksheet
    'begin jp July 2015
    Dim wkb As Workbook, strTemp As String, strFileName As String
    'end jp July 2015

    Dim nextRow As Long
    Dim oCol As Long

    Dim myRng As Range
    Dim myCopy As String
    Dim myCell As Range
    'start jp June 2015
    Dim strWS As String
    'end jp June 2015
    'cells to copy from Input sheet - some contain formulas
    myCopy = "D4,D16,D6,D8,D10,D12,D14,D18"

    Set inputWks = Worksheets("Input")
    Set historyWks = Worksheets("Tracker")

    With historyWks
        nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
    End With

    With inputWks
        Set myRng = .Range(myCopy)

        If Application.CountA(myRng) <> myRng.Cells.Count Then
            MsgBox "Please fill in all the cells!"
            Exit Sub
        End If
    End With

    'start June 2015
    Application.DisplayAlerts = False
    strWS = ThisWorkbook.Worksheets("Input").Range("D4").Value
    Set wkb = Workbooks.Add
    ThisWorkbook.Worksheets("WSForm").Copy Before:=wkb.Sheets(1)
    wkb.Worksheets("WSForm").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    wkb.Worksheets("WSForm").Name = ThisWorkbook.Worksheets("Input").Range("D4").Value
    On Error Resume Next
    'strFileName = "C:\temp\qn\" & ThisWorkbook.Worksheets("Input").Range("D4").Value & ".xlsx"
    strFileName = "c:\tracker\Tracker\" & ThisWorkbook.Worksheets("Input").Range("D4").Value & ".xlsx"
    wkb.SaveAs (strFileName)
    On Error GoTo 0
    Application.DisplayAlerts = True
    'end June 2015

    With historyWks
        'start jp
        .Rows(nextRow - 1).Copy .Rows(nextRow)
        'end jp

        With .Cells(nextRow, "A")
        End With
        oCol = 1
        For Each myCell In myRng.Cells
            historyWks.Cells(nextRow, oCol).Value = myCell.Value
            oCol = oCol + 1
        Next myCell
    End With
    'begin jp July 2015
    With ThisWorkbook.Worksheets("Tracker")
        strTemp = .Cells(nextRow, 1).Value
        .Hyperlinks.Add Anchor:=.Cells(nextRow, 1), Address:=strFileName, _
    End With
    'end jp June 2015
       On Error Resume Next
         With .Range(myCopy).Cells.SpecialCells(xlCellTypeConstants)
              Application.GoTo .Cells(1) ', Scroll:=True
         End With
      On Error GoTo 0
    End With
End Sub