1

Many years back we had to come up with a solution to survey results that we were getting via CSV. Back then we'd get data where the first column was e-mails, and subsequent columns were 1's or null to indicate interest in an organization. We were trying to come up with a solution that went through each column AFTER the e-mail column, and save out in separate workbooks a list of emails for each column that had a 1 in them so we could send it to those organizations.

Our data (simplified) looked like this:

enter image description here

Where the end result would provide 4 new .xlsx files (club1.xlsx, club2.xlsx, club3.xlsx,etc), each with the 'emails' that had 1's in their row for their respective column. (In the above example Club1.xlsx would have Email1, Email3, Email7 listed)

At the time, the StackExchange community was super helpful in helping us source a solution by providing the following VBA code to run a macro:

Option Explicit

Sub FilterData()
    Dim Responses As Worksheet
    Dim Column As Long

    Set Responses = ThisWorkbook.Worksheets("Responses")
    Column = 2

    Do While Responses.Cells(1, Column).Value <> ""
        With Workbooks.Add(xlWBATWorksheet)
            With .Worksheets(1)
                Responses.Cells.Copy .Cells
                .Columns(Column).AutoFilter Field:=1, Criteria1:="<>1"
                .Rows(2).Resize(.Rows.Count - 1).Delete Shift:=xlUp
                .Columns(2).Resize(, .Columns.Count - 1).Delete Shift:=xlShiftToLeft
            End With

            .Close SaveChanges:=True, Filename:=ThisWorkbook.Path & "\" & Responses.Cells(1, Column).Value
        End With

        Column = Column + 1
    Loop
End Sub

But our layout has since changed and for the life of us we can't figure out how to modify the code to include more columns in the save out. Instead of just having the 'Email' column, we now have additional columns for Preferred Name, First Name, Last Name, and Pronouns. Our attempts at modifying the above code has only served to either break the macro entirely, or only save out a single row.

Would anyone have and advice on to how we could either write new code, or modify the existing code to include all the columns in our exports (so Club1.xlsx would now have columns/row data for referred Name, First Name, Last Name, Pronouns, and Emails for each column with a "1").

Here's our new data set: enter image description here

Any thoughts? I'm stumped.

1

Without source data to try with, this would be my guestimate

I have created a procedure that should prompt for the source file, then create an output workbook and add a sheet for each club listing the interested party details for that club.

It assumes that the source file is an excel file with the extension "xlsx" Also it assume that the source data is on a sheet called "Response".

It closes the source file but not the generated workbook.

I have commented the code to explain how it works.

   Sub FilterData()

    '------------- Define the Variables -----------------
    'Define workbooks and worksheets
    Dim wbkSource As Workbook, shtSource As Worksheet '. Source Date
    Dim wbkList As Workbook, shtList As Worksheet '..... Final workbook with separate sheets

    'Define Index looping variables  and last positions
    Dim idxRows As Double, idxCols As Double
    Dim lastRow As Double, lastCol As Double

    'Define the identifier holders
    Dim fileName As String '................... Holds the selected source file name
    Dim clubName As String '................... Holds the current Club name
    Dim cntRows As Double '.................... Flags is there is a club entry or not and tracks the club entry position

    '----------------- Assign the startup values
    'Open the source file  and assign it as  wbkSource, when the user has not cancelled
    fileName = Application.GetOpenFilename("Excel File (*.xlsx),*.xlsx, All Files (*.*), (*.*)", , "Please select the source file")
    If fileName <> "False" Then

            'Assign the workbook source to the opened file
            Set wbkSource = Workbooks.Open(fileName)

            'Assign the source worksheet
            Set shtSource = wbkSource.Worksheets("Responses")

            'Create the output workbook and assign it to the wbkList
            Workbooks.Add
            Set wbkList = Workbooks(Workbooks.Count)

            'Define the last row and column positions
            lastRow = shtSource.Cells.SpecialCells(xlCellTypeLastCell).Row
            lastCol = shtSource.Cells.SpecialCells(xlCellTypeLastCell).Column

            '-------------------------------------- Loop through each possible club
            For idxCols = 6 To lastCol
                'Get the next club name and reset the flag
                clubName = shtSource.Cells(1, idxCols)
                cntRows = 0

                '----------------------------------- Loop for each row
                For idxRows = 2 To lastRow

                    'When we have an interest for this contact for this club
                    If shtSource.Cells(idxRows, idxCols) = 1 Then
                        'Increment the row count
                        cntRows = cntRows + 1

                            'If this is the first time create the worksheet for this club
                            If cntRows = 1 Then
                                wbkList.Worksheets.Add
                                Set shtList = wbkList.Worksheets.Add
                                shtList.Name = clubName

                                'Create the Title row
                                shtList.Cells(1, 1) = "Preferred"
                                shtList.Cells(1, 2) = "First"
                                shtList.Cells(1, 3) = "Last"
                                shtList.Cells(1, 4) = "Pronouns"
                                shtList.Cells(1, 5) = "Emails"

                                'Increment the row count to allow for the title
                                cntRows = cntRows + 1

                            End If

                            'Add the data to the club sheet
                            shtList.Cells(cntRows, 1) = shtSource.Cells(idxRows, 1)
                            shtList.Cells(cntRows, 2) = shtSource.Cells(idxRows, 2)
                            shtList.Cells(cntRows, 3) = shtSource.Cells(idxRows, 3)
                            shtList.Cells(cntRows, 4) = shtSource.Cells(idxRows, 4)
                            shtList.Cells(cntRows, 5) = shtSource.Cells(idxRows, 5)


                    End If 'Interested for this club

                Next idxRows
                '----------------------------------- each row

            Next idxCols
            '------------------------------------ Each Club

            'Turn off warning termporarily and close the source file
            Application.DisplayAlerts = False
            wbkSource.Close
            Application.DisplayAlerts = True


    Else
        'Notify the user of the cancelling of the macro
        MsgBox "Error: Canncelled by user, closing marco.", vbCritical, "User cancelled!"
    End If


    End Sub

Hope it helps, V.

  • Thanks for this - you did a SUPER deep dive. I'm on a Mac (though can move to a PC), so I removed the XLSX file filter attributes since they were breaking the macro when opening a dialog box. As far as functionality it worked. Kind of! It created a single new document with workbooks for each 'club' (plus some blank sheets in between them). We're looking to have a file per organization (rather than one workbook) so we can send the lists out individually - but I can't seem to figure out how to have it save each file individually (club1.xlsx, club2.xlsx, etc) – Cody S. Aug 30 '18 at 16:57
  • 1
    What you need to do is move the "Create the output workbook and assign it to wbklist" code down to just above "wbklist.worksheets.add" and sandwiched between put wbklist.saveas "<the directory you wish to save the workbooks to followed by a \" & clubname &".xls" And it should work for you. you will then be creating a new workbook and not just a new worksheet – VHalpenny Aug 31 '18 at 12:30
0

At the time, the StackExchange community was super helpful in helping us source a solution by providing the following VBA code to run a macro:

Does this have to be done in a kind of automated process? If not, you can just filter the entire table based on the values in column like club1, club2, club3, and copy the result to separate files. If you only have less than 10 'clubs', this might be faster than struggling to write VBA.

  • Our total data set has 200+ 'organizations'/columns and nearly 2000 rows, so to do a manual process would take a lengthy amount of time - which is why we're looking for an automated process. – Cody S. Aug 30 '18 at 13:54

Your Answer

By clicking "Post Your Answer", you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.