Extracting data with VBA macro button from files in designated folder

[CamBF]

Hi all,

Need an urgent solution to the below please, if possible. It is beyond my VBA capabilities.

I have created a new Excel workbook and inserted a macro button name "Import NC Data".

What I need the macro VBA code to do it to ask me to select / specify a specific folder (folder and location can vary from project to project), from which it will go through each file (there would be many) in that folder and pull data from each file.

The files in the folder are .nc1 files, which can be opened in Excel to display as text in cells.

For each file I need the VBA code to copy the entire cell contents of A5 and paste it in the Excel workbook with the macro, in cell A5.

I then need the VBA code to search column A from that same nc1 file that it just copied A5's contents from for a cell containing only the letters "SI". Once it finds the cell containing "SI", I need the code to copy the cell below it in column A, but only the first 5 characters. Then paste those 5x characters in the Workbook with the macro, in cell B5 (Cell to the right of the previously copy and pasted A5 contents).

The first 5x characters will consist of either spaces and the letter "u" or the letter "o". If any other text character appears in these first 5x characters it would be great if the code could notify the user of which .nc1 file has the different text character and stop the code immediately.

The row that contains "SI" can vary in row number from nc1 file to nc1 file so the code will need to search through all of column A. There will only be one cell in column A that contains "SI".

The VBA code would then look at the next .nc1 file and copy the entire cell contents of A5 and paste it in the Excel workbook with the macro, in cell A6. The code would then do the same as before searching the second .nc1 file for "SI" in column A. Once finding it, copying the first 5x characters of the cell contents below it and pasting them into the Excel workbook with the macro in cell B6.

The code would then move onto the 3rd .nc1 file and so on. Eventually there would be a list in the Workbook with the macro with data in both columns A and B. The contents of each row A and B would be from the same .nc1 file. So if there was data in columns A and B, rows 5-9 then there would have been 5x .nc1 files in the selected folder.

Once the VBA code has scanned all .nc1 files then it will be complete.

Thanks in advance guys, hopefully the above make sense.

 

[Micron]

Try this on a copy of your wb. With only 3 files, I was not able to test scenarios (e.g. SI is in all 3 files). See notes in the code beginning with ***** and make necessary changes. One change will be the sub name for sure.

Sub CamBF2()
Dim fd As FileDialog
Dim strPath As String, strFile As String
Dim wb As Workbook, sht As Worksheet
Dim i As Integer, x As Integer
Dim rng As Range
Dim var As Variant

On Error GoTo errHandler
With Application
    .DisplayAlerts = False
    .EnableEvents = False
    .ScreenUpdating = False
End With
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
    .Title = "Select project folder"
    '*****change intial file path string or commentout/remove next line
    .InitialFileName = "C:\Users\Micron\Access\MrExcel\" 'valid path here will open dialog at a preferred point
    .ButtonName = "Select"
    If .Show = -1 Then
        strPath = .SelectedItems(1) & "\"
    Else
        MsgBox "You canceled folder selection. Process will now terminate."
        Exit Sub
    End If
End With

'****specify correct sheet name for your file
Set sht = ThisWorkbook.Sheets("Week to Week")
sht.UsedRange.ClearContents

strFile = Dir(strPath & "*.nc1")
i = 5
Do While Len(strFile) > 0
    Set wb = Workbooks.Open(strPath & strFile)
    Trim (wb.Worksheets(1).Range("A5").Copy)
    sht.Range("A" & i).PasteSpecial Paste:=xlValues
    Set rng = wb.Worksheets(1).Cells.Find(what:="SI")
    If rng Is Nothing Then
        Range("B" & i) = ""
        x = x + 1
    Else
        var = Left(rng.Offset(1, 0), 5)
        If Trim(var) Like "u" Then sht.Range("B" & i) = "u"
        If Trim(var) Like "o" Then sht.Range("B" & i) = "o"
    End If
    
    '*****i will increment even if SI is not found. Correct?
    i = i + 1
    strFile = Dir
    wb.Close
Loop
MsgBox "Out of " & i - 5 & " file(s) processed, " & x & " had no SI value."
sht.Activate

exitHere:
With Application
    .DisplayAlerts = True
    .EnableEvents = True
    .ScreenUpdating = True
End With
Exit Sub

errHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume exitHere

End Sub