Filter and reorder columns in Excel

Question

I've got a service (phplist, a newsletter manager) that exports a user list with several fields. At the end of it, each user has one or more lists to which he has subscribed.

The problem is, that table is not ordered as I'd like to, and instead of creating a new column for each lists, each rows creates the columns it needs. This is an example:

What I would want is, if I've got for example eight newsletters (lists), to be able in Excel to convert that table to one that creates the proper columns and fills the data within. The result of the previous table converted would be this:

Or something similar (instead of a Yes or blank, I could have a Yes and No, whatever). This way I could filter the table by list, which is impossible with my current table: the columns in the source table, as you can see, can contain different lists on each row. Is this possible in Excel?

Final solution:

Thanks to W_Whalley I was able to find the real answer to the problem. If somebody has used PHPList, this newsletter manager allows you to download the list of subscribed users, but as I mentioned on the original question, it doesn't give you the lists they are subscribed to in a good way. In fact, it gives you a final colum with all the lists in the same cell. That is slightly different that the problem I considered, because a row of that table would be:

Name | Surname |     Email    |    Lists

John | Perry | john@mail.com | List1 List3 List6 List 7

And not

Name | Surname |     Email    |    Lists

John | Perry | john@mail.com | List1 |  List3 | List6 | List 7

I proposed the second table because I thought it was easier to manage, but it wasn't. In fact, I had to make a little modification to get different colums for each list after exporting the user list from PHPList. This was not neccessary.

I exported the user list right away, and the solution was to apply the formula W_Whalley suggested considering only one column at a time. Doing this for several columns worked. The final formula (using an example row and column) was:

=IF(ISERROR(SEARCH(L$1,$D2)),"no","yes")

Or, in spanish version of Excel (the one I was using) with an example column:

=SI(ESERROR(HALLAR($AJ$1;$AI27));"";"SI")

Hope this is useful for somebody out there. Thanks everyone, specially W_Whalley!!

Answer 1

Here's a non-VBA solution. Assuming that you have at most 8 lists (you can adjust as needed) and that for convenience the table you start with starts at cell A1. Put the string names for the lists in cells L1 to S1. Enter this formula in cell L2 =IF(ISERROR(SEARCH(L$1,$D2&$E2&$F2&$G2&$H2&$I2&$J2&$K2)),"no","yes") Copy this formula from L1 to S2, then copy down as far as you need to go.

What it's doing: The SEARCH("listN",[concatenated "list1...list8"]) returns the starting index number of the matching part of the string or, if not found, a #VALUE error (at least in LibreOffice..sorry, don't have Excel to test with). The ISERROR function returns "no" if there is an error and "yes" if not, that is if the string "listN" is found in the concatenated list names.

You can then filter the table using the autofilter function. Seems to work with 60,000 rows.

Answer 2

This is a VBA solution in case the formula solution doesn't meet your requirements.

I have divided the code into little blocks so I can explain them individually. I include Debug.Print commands so you can understand what each block is doing. I hope I have the level of explanation about right.

Option Explicit
' "Option Explicit" means you have to explicitly declare every variable
' but you will get a "variable not declared" warning if you try to run
' your code with a misspelt variable.

Sub Rearrange()

  Dim ColOldCrnt As Integer
  Dim ColOldMax As Integer
  Dim RowCrnt As Long         ' Long in case there are more than 32767 rows
  Dim RowMax As Long          ' Use same row variable for both sheets
  Dim SheetOld() As Variant

  ' The first block of code (down to "Debug.Assert False") assumes your
  ' current list is in worksheet "Sheet1".  Change the "With Sheets()"
  ' command as necessary.

  ' The code finds the bottommost row and the rightmost column and then
  ' loads the entire rectangle to array SheetOld.  It is much faster using an
  ' array than accessing individual cells as necessary.

  With Sheets("Sheet1")
    RowMax = .Cells.Find("*", .Range("A1"), xlFormulas, , _
                                               xlByRows, xlPrevious).Row
    ColOldMax = .Cells.Find("*", .Range("A1"), xlFormulas, , _
                                         xlByColumns, xlPrevious).Column
    SheetOld = .Range(.Cells(1, 1), .Cells(RowMax, ColOldMax)).Value
  End With

  Debug.Print "Max row = " & RowMax
  Debug.Print "Max col = " & ColOldMax

  Debug.Print "First 15 rows from old sheet"
  For RowCrnt = 1 To 15
    For ColOldCrnt = 1 To ColOldMax
      ' With two dimensional arrays it is normal to have the column as the
      ' first dimension.  With arrays loaded from a worksheet, the row is
      ' the first dimension.
      Debug.Print "|" & SheetOld(RowCrnt, ColOldCrnt);
    Next
    Debug.Print "|"
  Next

  Debug.Assert False     ' This stops the routine until you press continue (F5)
                         ' Press Ctrl+G if you cannot see the Immediate Window.

  ' Normally I would put all the variables as the top but I want to discuss each
  ' block's variables separately.

  ' This block builds in array "ListName()" a list of all the names.  The list
  ' is in the order in which names are found.  If you have a mispelt name (for
  ' example: "Lsit1") you will get a column for "Lsit1".  You may have to run
  ' the routine, correct any mispelt names and then rerun.

  ' This is not top quality code.  I have had to compromise between good
  ' and easy to understand.  I hope I have the balance right.

  Dim Found As Boolean
  Dim InxNameCrnt As Integer
  Dim InxNameCrntMax As Integer
  Dim NameList() As String
  Dim NameCrnt As String

  ' Using constants makes the code a little easier to understand.
  ' I use the same constants for both the old and new sheets because
  ' the important columns are in the same sequence.
  Const ColFirstList As Integer = 4

  ReDim NameList(1 To 100)      ' Bigger than could be necessary
  InxNameCrntMax = 0

  For RowCrnt = 2 To RowMax
    For ColOldCrnt = ColFirstList To ColOldMax
      ' Get a name out of the array and trim any leading
      ' or trailing spaces
      NameCrnt = Trim(SheetOld(RowCrnt, ColOldCrnt))
      If NameCrnt <> "" Then
        Found = False
        ' Search the current list for this name
        For InxNameCrnt = 1 To InxNameCrntMax
          If NameList(InxNameCrnt) = NameCrnt Then
            ' This name already recorded
            Found = True
            Exit For      ' Exit search
          End If
        Next
        If Not Found Then
          ' Add this name to the end of the list
          InxNameCrntMax = InxNameCrntMax + 1
          NameList(InxNameCrntMax) = NameCrnt
        End If
      End If
    Next
  Next

 Debug.Print "Names in order found:"
 For InxNameCrnt = 1 To InxNameCrntMax
   Debug.Print "|" & NameList(InxNameCrnt);
 Next
 Debug.Print "|"

 Debug.Assert False     ' This stops the routine until you press continue (F5)

 ' The next block builds the output worksheet in array SheetNew().

  ' I have used "Given" and "Family" instead of "Name" and "Surname" so I
  ' can reserve "Name" for the list names.
  Const ColGiven As Integer = 1
  Const ColFamily As Integer = 2
  Const ColEmail As Integer = 3

  Dim ColNewCrnt As Integer
  Dim ColNewMax As Integer
  Dim SheetNew() As String

  ' One column for the columns to the left of the first name and then
  ' one per name.
  ReDim SheetNew(1 To RowMax, 1 To ColFirstList - 1 + InxNameCrntMax)

  ' Copy across columns heading for the first columns
  For ColNewCrnt = 1 To ColFirstList - 1
    SheetNew(1, ColNewCrnt) = SheetOld(1, ColNewCrnt)
  Next
  ' Head the remaining columns with name
  For InxNameCrnt = 1 To InxNameCrntMax
    SheetNew(1, ColFirstList - 1 + InxNameCrnt) = NameList(InxNameCrnt)
  Next

  Debug.Print "First row from new sheet:"
  For RowCrnt = 1 To 1
    For ColNewCrnt = 1 To UBound(SheetNew, 2)
      Debug.Print "|" & SheetNew(RowCrnt, ColNewCrnt);
    Next
    Debug.Print "|"
  Next

 Debug.Assert False     ' This stops the routine until you press continue (F5)

 ' This block copies information from the old sheet to the new sheet

  For RowCrnt = 2 To RowMax
    ' Copy the initial columns unchanged
    For ColNewCrnt = 1 To ColFirstList - 1
      SheetNew(RowCrnt, ColNewCrnt) = SheetOld(RowCrnt, ColNewCrnt)
    Next
    For ColOldCrnt = ColFirstList To ColOldMax
      ' Get a name out of the old sheet and trim any leading
      ' or trailing spaces
      NameCrnt = Trim(SheetOld(RowCrnt, ColOldCrnt))
      If NameCrnt <> "" Then
        Found = False
        ' Search the current list for this name
        For InxNameCrnt = 1 To InxNameCrntMax
          If NameList(InxNameCrnt) = NameCrnt Then
            ' Name found
            Found = True
            Exit For      ' Exit search
          End If
        Next
        Debug.Assert Found  ' Name found on first pass but not second
                            ' Program error
        SheetNew(RowCrnt, ColFirstList - 1 + InxNameCrnt) = "Yes"
      End If
    Next
  Next

  Debug.Print "First 15 rows from new sheet:"
  For RowCrnt = 1 To 15
    For ColNewCrnt = 1 To UBound(SheetNew, 2)
      Debug.Print "|" & SheetNew(RowCrnt, ColNewCrnt);
    Next
    Debug.Print "|"
  Next

 Debug.Assert False     ' This stops the routine until you press continue (F5)

 ' This code assumes the destination sheet is "Sheet2". Change the
 ' "With Sheets()" command if necessary

 With Sheets("Sheet2")
   .Cells.EntireRow.Delete      ' Remove everything for the sheet
   .Rows(1).Font.Bold = True     ' Set the top row to bold
   'Load the worksheet from the array
   .Range(.Cells(1, 1), .Cells(RowMax, UBound(SheetNew, 2))).Value = SheetNew

 End With

 ' I have not bothered about column widths and the columns are in the
 ' sequence found.  You could add a dummy row at the top of the old sheet
 ' for John Doe who gets every list in the sequence you require.  Alternately
 ' you could sort the rows by hand.


End Sub

I hope this all makes sense. Best of luck if you use this approach.