Question

I have never coded in VBA but I’m trying to transpose some knowledge from obj-c into this.

-I want to open a file (about 200 files in a folder)

-look through the range of cells in each file

-then find everything (words) before the first comma in each cell (cells in this range have three commas)

-add the value of each cell to an array

(scan the remaining files and do the same)

-take results array and paste them all in another file named master list

I think I have covered most of this (first time with VBA though so not sure), but I haven’t figured out how to read everything up to the first comma in each cell

Also please let me know if I have any obvious errors, or logic issues

Thank you in advance

Thank you for your help!

Sub CopyWordsToMainFileRow()

Dim Cell As Range
Dim counter As Integer
Dim word As String
Dim arrayOfIngredients() As Variant 'array of words from search
Dim fileName As String
Dim arrayOfFileNames As Variant
Dim MainCounter As Integer
Dim p As String, x As Variant

MainCounter = 0
counter = 0

' Make array of file names
    p = "/Users/waf04/Desktop/*.xls"
    arrayOfFileNames = GetFileList(p)

    Select Case IsArray(arrayOfFileNames)
        Case True 'files found
            MsgBox UBound(arrayOfFileNames)
            Sheets("Sheet1").Range("A:A").Clear
            For i = LBound(arrayOfFileNames) To UBound(arrayOfFileNames)
                Sheets("Sheet1").Cells(i, 1).Value = arrayOfFileNames(i)
            Next i
        Case False 'no files found
            MsgBox "No matching files"
    End Select
'end make array of file names

'Create array from cells in each file
For fileNameCounter = 0 To UBound(arrayOfFileNames)

    fileName = arrayOfFileNames(MainCounter)
    Workbooks.Open fileName:="fileName"
    arrayOfIngredients = Range("AT2:EP200").Value 'add value of cells to array

    'make array of results for each file
    For Each Cell In Range("AT2:EP200")
        word = Cell.Value ' make this string equal to the value of everything before the first comma in that cell
        arrayOfIngredients(counter) = word 'add string to array
        counter = counter + 1
        Next Cell

Workbooks.Close fileName:="fileName"
Next fileNameCounter
'==============================
'Output unsorted array
Workbooks.Open fileName:="/Users/waf04/Desktop/ingredients_collection.xlsx"
Range("A1:A" & UBound(arrayOfIngredients) + 1) = _
WorksheetFunction.Transpose(arrayOfIngredients)

End Sub

Answer 1

Here’s your code revised to address some lgic issues and to show how to get the string up to the first comma.

This outputs comma separated list of words from each file in a single column in output file.

I’ve assume in all cases the worksheet of interest in each workbook is index 1. You may need to change this to suit your sheets.

Note: I have developed this on a Windows machine, it may mave issues on Mac I am unaware of.

Changes are explained with comments ' *** like this

Sub CopyWordsToMainFileRow()
    Dim cell As Range
    Dim counter As Long 'Integer *** no advanatge in using Integer, and risks overflow
    Dim word As Variant  'String *** need variant for For Each loop
    Dim arrayOfIngredients() As Variant 'array of words from search
    Dim fName As String ' fileName As String *** dont use keywords as variables
    Dim arrayOfFileNames As Variant
    Dim MainCounter As Long 'Integer
    Dim p As String, x As Variant

    ' *** extra variables
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim arrayFromSheet As Variant
    Dim CellValue As Variant

    ' *** not used ?
'    MainCounter = 0
'    counter = 0

    ' Make array of file names
    p = "/Users/waf04/Desktop/*.xls"
    arrayOfFileNames = GetFileList(p)

    Select Case IsArray(arrayOfFileNames)
        Case True 'files found
            MsgBox UBound(arrayOfFileNames)
            With Sheets("Sheet1") ' *** avoid multiple references to sheet
                .Range("A:A").Clear
'            For i = LBound(arrayOfFileNames) To UBound(arrayOfFileNames)
'                Sheets("Sheet1").Cells(i, 1).Value = arrayOfFileNames(i)
'            Next i

            ' *** put file names into sheet in one step ***
                .Range(.Cells(1, 1), .Cells(UBound(arrayOfFileNames) - LBound(arrayOfFileNames) + 1)) = arrayOfFileNames
            End With
        Case False 'no files found
            MsgBox "No matching files"
            ' ***** End Sub here. ***
            Exit Sub
    End Select
    'end make array of file names

    ' *** Initialise results array: Range("AT2:EP200")  has 20099 cells
    ReDim arrayOfIngredients(1 To 20099)  ' <== you may want a more generic sizing solution


    'Create array from cells in each file
    'For fileNameCounter = 0 To UBound(arrayOfFileNames)
    For fileNameCounter = LBound(arrayOfFileNames) To UBound(arrayOfFileNames) ' *** handle 0 or 1 based arrays

        fName = arrayOfFileNames(fileNameCounter) ' MainCounter) *** use correct counter
        Set wb = Workbooks.Open(fileName:=fName)  ' *** use  variable, use workbook object
        Set ws = wb.Worksheets(1) ' *** use worksheet object, set to required sheet
        ' *** don't overwrite prior results, so don't need this line
        ' arrayOfIngredients = ws.Range("AT2:EP200") 'add value of cells to array 

        'make array of results for each file
        '  *** don't loop over cells, get data into an array instead
        arrayFromSheet = ws.Range("AT2:EP200")
        counter = 1 ' *** initialise counter for each file
        'For Each Cell In Range("AT2:EP200")
        For Each word In arrayFromSheet
            ' *** see new code below
            'word = Cell.Value ' make this string equal to the value of everything before the first comma in that cell
            i = InStr(word, ",")
            If i > 0 Then
                arrayOfIngredients(counter) = arrayOfIngredients(counter) & Left$(word, i - 1) & ","  ' *** add string to array
            Else
                ' *** what to do if no , ???
            End If
            counter = counter + 1
        Next word

        wb.Close SaveChanges:=False ' *** close object
    Next fileNameCounter
    '==============================
    'Output unsorted array
    ' *** strip trailing comma
    For i = LBound(arrayOfIngredients) To UBound(arrayOfIngredients)
        If Len(arrayOfIngredients(i)) > 0 Then
            arrayOfIngredients(i) = Left$(arrayOfIngredients(i), Len(arrayOfIngredients(i)) - 1)
        End If
    Next i
    Set wb = Workbooks.Open(fileName:="/Users/waf04/Desktop/ingredients_collection.xlsx") ' *** use object
    wb.Worksheets(1).Range("A1:A" & UBound(arrayOfIngredients) - LBound(arrayOfIngredients) + 1) = _
    Application.Transpose(arrayOfIngredients) ' *** use object and use Application rather than Worksheet tramspose

End Sub