Extracting Specific Values from Separate Workbooks for a Master Workbook

[bck]

Hi there,

I'm looking for help coding a specific macro multiple workbook task. Here's what I'm trying to do:

I have a folder, titled "Analysis". Inside it there is a "MasterList.xls" workbook and a "Data" folder.
Inside the "Data" folder are all my source workbooks.
The source workbooks are for two variables ('Word' or 'Image'), two conditions each ('6'--which is 'bigger', and '7'--which is 'smaller'), so there are 4 types of workbooks:
"6word_XXXX.xls"
"7word_XXXX.xls"
"6image_XXXX.xls"
"7image_XXXX.xls"
where XXXX is the subject number; there are about 150 subjects, so its 600 files, give or take.
In the each workbook, there is only ONE worksheet per workbook.
In the 'word' workbooks, I need to 'grab' 24 specific data points to export to the MasterList.xls
In the 'image' workbooks, I need to 'grab' 48 specific data points to export to the MasterList.xls
The MasterList.xls workbook has 5 worksheet tabs, only two of which are relevant: "Words" and "Images".

I want the Macro to:

Open MasterList.xls
Make some sort of list of the Data directory
Make a loop using the list of the Data directory
In that loop,
    For each '6word_*.xls" file:
        Open each file
        Grab the subject number (it's always in "A1")
        Grab the 24 specific values
        Export them to the MasterList, "Words" worksheet, on the next empty row in order (so on one row: SubjNum, Value1, Value2, etc.)
    End
    For each '7word_*.xls" file:
        Open each file
        Find that subject's previous line from the other condition (so if the current file is "7word_LZ154", it can take its own subject number from the current file (always "A1") and match it up with the LZ154 line from "6word_LZ154")
        Then, enter the grabbed 24 values from the 7word_*.xls file, starting with column "AA", as thats where all the 7word values start
    End
    For each '6image_*.xls" file:
        Open each file
        Grab the subject number (it's always in "A1")
        Grab the 48 specific values
        Export them to the MasterList, "Images" worksheet, on the next empty row in order (so on one row: SubjNum, Value1, Value2, etc.)
    End
    For each '7image_*.xls" file:
        Open each file
        Find that subject's previous line from the other condition (so if the current file is "7image_LZ154", it can take its own subject number from the current file (always "A1") and match it up with the LZ154 line from "6image_LZ154")
        Then, enter the grabbed 48 values from the 7word_*.xls file, starting with column "AY", as thats where all the 7image values start
    End
End loop

Hope this is clear. Thanks for all your help!

-bck

 

[RolfJ]

A couple of questions:

• Do you actually need the list of files in your Data directory in your MasterList workbook (it is not required to loop through the files)?
• In which cells are the specific values you would like to grab from each workbook located?

Here is a code template of what this might look like (the specific actions to take for each opened workbook should be relatively easy to code once you clarified where the 'specific values' are located):

Const FOLDERNAME = "{you need to specify the full path name of the Data folder}"
 
Sub FilesInFolder()
    Dim fs As Object
    Dim objFolder As Object
    Dim objFile As Object
 
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set objFolder = fs.GetFolder(FOLDERNAME)
 
    Dim wb As Workbook
    For Each objFile In objFolder.Files
        If InStr(objFile.Name, ".xls") > 0 Then
            If InStr(objFile.Name, "6word") > 0 Then
                Set wb = Workbooks.Open(objFile.Path)
                'Grab the subject number (it's always in "A1")
                'Grab the 24 specific values
                'Export them to the MasterList, "Words" worksheet, on the next empty row in order (so on one row: SubjNum, Value1, Value2, etc.)
                wb.Close (False)
            ElseIf InStr(objFile.Name, "7word") > 0 Then
                Set wb = Workbooks.Open(objFile.Path)
                'Find that subject's previous line from the other condition (so if the current file is "7word_LZ154", it can take its own subject number from the current file (always "A1") and match it up with the LZ154 line from "6word_LZ154")
                'Then, enter the grabbed 24 values from the 7word_*.xls file, starting with column "AA", as thats where all the 7word values start
                wb.Close (False)
            ElseIf InStr(objFile.Name, "6image") > 0 Then
                Set wb = Workbooks.Open(objFile.Path)
                'Grab the subject number (it's always in "A1")
                'Grab the 48 specific values
                'Export them to the MasterList, "Images" worksheet, on the next empty row in order (so on one row: SubjNum, Value1, Value2, etc.)
                wb.Close (False)
            ElseIf InStr(objFile.Name, "7image") > 0 Then
                Set wb = Workbooks.Open(objFile.Path)
                'Find that subject's previous line from the other condition (so if the current file is "7image_LZ154", it can take its own subject number from the current file (always "A1") and match it up with the LZ154 line from "6image_LZ154")
                'Then, enter the grabbed 48 values from the 7word_*.xls file, starting with column "AY", as thats where all the 7image values start
                wb.Close (False)
        End If
    Next
End Sub

 

[bck]

Rolf, Thanks so much for your help.

-Nope, don't need a list of the directory in the sheet, just so long as it works through each of them and puts the appropriate cells in the MasterList.xls

-The cells I wish to grab in the "6word_*" and "7word_*" files are:
The subject number ("A1" in all source files) and then, the 24 cells are:
M7, M15, M23, M31, M39, M47, M55, M63, M9, M17, M25, M33, M41, M49, M57, M65, M11, M19, M27, M35, M43, M51, M59, M67

So, maybe:

x = 7
While x<100
    grab Mx
    if x = 63
       x = 9
    if x = 65
       x = 11
    x = x + 8
    if x = 74
        x = 100
    End
End

(or something like this)

So, the final output line for the MasterList "Words" worksheet would be:
SubjNum, BLANK CELL, 24cells from 6word file, 24 cells from 7word file:

A1, BLANK CELL, M7, M15, M23, M31, M39, M47, M55, M63, M9, M17, M25, M33, M41, M49, M57, M65, M11, M19, M27, M35, M43, M51, M59, M67, M7, M15, M23, M31, M39, M47, M55, M63, M9, M17, M25, M33, M41, M49, M57, M65, M11, M19, M27, M35, M43, M51, M59, M67


Next, with the "6image_*" and "7image_*" files, it's similar:
The cells I wish to grab in the "6image_*" and "7image_*" files are:
The subject number ("A1" in all source files) and then, the 48 cells are:
N7, N15, N23, N31, N39, N47, N55, N63, N9, N17, N25, N33, N41, N49, N57, N65, O7, O15, O23, O31, O39, O47, O55, O63, O9, O17, O25, O33, O41, O49, O57, O65, P7, P15, P23, P31, P39, P47, P55, P63, P9, P17, P25, P33, P41, P49, P57, P65

so, a version of a formula to work out the needed cell numbers might be:

x="N"
y=7
While y>74
     Grab Cell (xy)
     y=y+8
     if x="N" and y=71; then
          y=9
     end
     if x="N" and y=73; then
          x="O"
          y=7
     end
     if x="O" and y=71; then
          y=9
     end
     if x="O" and y=73; then
          x="P"
           y=7
      end
     if x="P" and y=71; then
           y=9
      end
     if x="P" and y=73; then
           y=100
      end
End While

I'm sure there's a better way to do this, but this was my stab at it.

So, the final output line for the MasterList "Images" worksheet would be:
SubjNum, BLANK CELL, 48cells from 6image file, 48 cells from 7image file:

A1, BLANK CELL, N7, N15, N23, N31, N39, N47, N55, N63, N9, N17, N25, N33, N41, N49, N57, N65, O7, O15, O23, O31, O39, O47, O55, O63, O9, O17, O25, O33, O41, O49, O57, O65, P7, P15, P23, P31, P39, P47, P55, P63, P9, P17, P25, P33, P41, P49, P57, P65, N7, N15, N23, N31, N39, N47, N55, N63, N9, N17, N25, N33, N41, N49, N57, N65, O7, O15, O23, O31, O39, O47, O55, O63, O9, O17, O25, O33, O41, O49, O57, O65, P7, P15, P23, P31, P39, P47, P55, P63, P9, P17, P25, P33, P41, P49, P57, P65


Hope this helps. Thanks again!

 

[RolfJ]

Coding the specifics should be rather straightforward. HOWEVER upon reading your specific requirements once again I just realized that the files have to be processed in a pre-defined order (e.g. the 6word file before the 7word workbook). That requires a bit mor thought.

While I am thinking would it be possible for your to send me sample files to exercise the code with? Use office@soarentcomputing.com if you can't post them somewhere.

Best wishes.

 

[RolfJ]

Give this code a try (please note that it will start filling your MasterList workbook on row 1 (but you may change that by changing the constant FIRSTMASTERROW):

Const FOLDERNAME = "{Full path name of your Data folder}"
Const FIRSTMASTERROW = 1
 
Private masterWb As Workbook
Private sourceWb As Workbook
Private subjectNumber As String
Sub FilesInFolder()
 
    Set masterWb = ActiveWorkbook
 
    Dim fs As Object
    Dim objFolder As Object
    Dim objFile As Object
 
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set objFolder = fs.GetFolder(FOLDERNAME)
 
    Dim cArray As Variant
    Dim masterWordsRow As Long, masterImagesRow As Long
    masterWordsRow = FIRSTMASTERROW
    masterImagesRow = FIRSTMASTERROW
    Dim targetRow As Long
    For Each objFile In objFolder.Files
        If InStr(objFile.Name, ".xls") > 0 Then
            If InStr(objFile.Name, "6word") > 0 Then
                Set sourceWb = Workbooks.Open(objFile.Path)
                subjectNumber = sourceWb.Sheets(1).Range("A1")
                cArray = Array("M7", "M15", "M23", "M31", "M39", "M47", "M55", "M63", "M9", "M17", "M25", "M33", "M41", "M49", "M57", "M65", "M11", "M19", "M27", "M35", "M43", "M51", "M59", "M67")
                targetRow = SubjectNumberRow("Words")
                If targetRow = 0 Then
                    Call CopyCells(cArray, "Words", "C" & masterWordsRow)
                    masterWordsRow = masterWordsRow + 1
                Else
                    Call CopyCells(cArray, "Words", "C" & targetRow)
                End If
                sourceWb.Close (False)
            ElseIf InStr(objFile.Name, "7word") > 0 Then
                Set sourceWb = Workbooks.Open(objFile.Path)
                subjectNumber = sourceWb.Sheets(1).Range("A1")
                cArray = Array("M7", "M15", "M23", "M31", "M39", "M47", "M55", "M63", "M9", "M17", "M25", "M33", "M41", "M49", "M57", "M65", "M11", "M19", "M27", "M35", "M43", "M51", "M59", "M67")
                targetRow = SubjectNumberRow("Words")
                If targetRow = 0 Then
                    Call CopyCells(cArray, "Words", "AA" & masterWordsRow)
                    masterWordsRow = masterWordsRow + 1
                Else
                    Call CopyCells(cArray, "Words", "AA" & targetRow)
                End If
                sourceWb.Close (False)
            ElseIf InStr(objFile.Name, "6image") > 0 Then
                Set sourceWb = Workbooks.Open(objFile.Path)
                subjectNumber = sourceWb.Sheets(1).Range("A1")
                cArray = Array("N7", "N15", "N23", "N31", "N39", "N47", "N55", "N63", "N9", "N17", "N25", "N33", "N41", "N49", "N57", "N65", "O7", "O15", "O23", "O31", "O39", "O47", "O55", "O63", "O9", "O17", "O25", "O33", "O41", "O49", "O57", "O65", "P7", "P15", "P23", "P31", "P39", "P47", "P55", "P63", "P9", "P17", "P25", "P33", "P41", "P49", "P57", "P65")
                targetRow = SubjectNumberRow("Images")
                If targetRow = 0 Then
                    Call CopyCells(cArray, "Images", "C" & masterImagesRow)
                    masterImagesRow = masterImagesRow + 1
                Else
                    Call CopyCells(cArray, "Images", "C" & targetRow)
                End If
                sourceWb.Close (False)
            ElseIf InStr(objFile.Name, "7image") > 0 Then
                Set sourceWb = Workbooks.Open(objFile.Path)
                subjectNumber = sourceWb.Sheets(1).Range("A1")
                cArray = Array("N7", "N15", "N23", "N31", "N39", "N47", "N55", "N63", "N9", "N17", "N25", "N33", "N41", "N49", "N57", "N65", "O7", "O15", "O23", "O31", "O39", "O47", "O55", "O63", "O9", "O17", "O25", "O33", "O41", "O49", "O57", "O65", "P7", "P15", "P23", "P31", "P39", "P47", "P55", "P63", "P9", "P17", "P25", "P33", "P41", "P49", "P57", "P65")
                targetRow = SubjectNumberRow("Images")
                If targetRow = 0 Then
                    Call CopyCells(cArray, "Images", "AY" & masterImagesRow)
                    masterImagesRow = masterImagesRow + 1
                Else
                    Call CopyCells(cArray, "Images", "AY" & targetRow)
                End If
                sourceWb.Close (False)
            End If
        End If
    Next objFile
End Sub
Private Sub CopyCells(cArray As Variant, targetSheetName As String, targetCell As String)
    Dim iCol As Integer
    masterWb.Sheets(targetSheetName).Range("A" & Range(targetCell).Row) = subjectNumber
    Dim c As Variant
    For Each c In cArray
        sourceWb.Sheets(1).Range(c).Copy masterWb.Sheets(targetSheetName).Range(targetCell).Offset(, iCol)
        iCol = iCol + 1
    Next c
End Sub
Public Function SubjectNumberRow(targetSheetName As String) As Long
    Dim r As Range
    Set r = Range(masterWb.Sheets(targetSheetName).Range("A1"), masterWb.Sheets(targetSheetName).Range("A" & Rows.Count).End(xlUp))
    Dim rValues As Variant
    rValues = r
    If r.Cells.Count = 1 Then
        If r.Cells = "" Then
            SubjectNumberRow = 0
        Else
            SubjectNumberRow = r.Row
        End If
        Exit Function
    End If
    Dim iRow As Long
    For iRow = 1 To UBound(rValues, 1)
        If rValues(iRow, 1) = subjectNumber Then
            SubjectNumberRow = iRow
            Exit Function
        End If
    Next iRow
    SubjectNumberRow = 0
End Function

Hope this helped.