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."
        GoTo exitHere
    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

 

[CamBF]

Hey Micron,

I am getting the attached error when I go to run it, I have changed the initial file path to my desktop.

I have then changed the sheet name in "" to "Purlin Orientation".

Is that all that needed changing?

 

[CamBF]

Hi Micron,

Nevermind got it to work thank you

I will test it on a larger number of files and let you know how it goes

 

[CamBF]

Hi Micron,

Ok so I tried it on a larger range of files. The results appear correct where it shows results (checked about 5-10 .nc1 files vs the result in the workbook), however it has missed some when I ran the code. See attached screenshot.

Also see link below to a Dropbox folder with all the .nc1 files I just tried to scan with the code.

Dropbox

www.dropbox.com

Hopefully this is an easy fix?

It picked up some near the end as well but there was a large area in the middle where it looks like it skipped them.

 

[Micron]

I think the issue might be that some of the var values contain characters that need to be escaped, but I really don't see any. In testing with the posted code, the Like test returns false for some files. So my suggestion is to use Instr() to look for o or u. Did that and all files returned one of those characters. Try changing this part between the Else and End If. Don't forget to use your sheet name:

    Else
        var = Trim(Left(Rng.Offset(1, 0), 5))
        If InStr(var, "u") > 0 Then ThisWorkbook.Sheets("Week to Week").Range("B" & i) = "u"
        If InStr(var, "o") > 0 Then ThisWorkbook.Sheets("Week to Week").Range("B" & i) = "o"
    End If

 

[CamBF]

Hi Micron,

That seems to work perfect, thanks so much for your help

 

[Micron]

Glad I could help & thanks for the recognition. And thanks for your patience.

 

[Micron]

BTW, I now figure that the issue was my code didn't use a wildcard with Like. I probably should have used Like "*o" and Like "*u".

 

[CamBF]

Hi Micron,

Do you believe this would have any improvement to the processing speed?

I used it before on 624 files and it took about 7 minutes from start to finish (finish being displaying values in workbook).

Not saying that is slow by any means, just seeing if you think the above change could reduce that 7 minutes to a quicker timeframe.

I also used it on another folder with 1400-ish files, no issues. Took a while, but that's understandable with that many files.

 

[Micron]

Don't know for sure about that, but fairly certain that the slowness comes from opening/closing files. If there is a way to read data from a group of files without opening them, I don't know it. So the slowness won't be fixed by how the code extracts data from a cell and determines if it contains o or u.

I had wondered about counting the nc1 files in a folder first to warn a user about the impact. That's not something I know how to do at this point.