Macro to match values in cells separated by semicolon and comma

Dear All,

My excel sheet contains 6 columns with information that is related to each other. In 3 of the columns (D-F) there are multiple entries, most of the time separated either by "%7C" and/or by a "comma". The data on column F is organized in a way that relates to how information is given (organized) in columns D and E. I need to match the score information on column F with correspondent experiment and sample information on columns D and E, respectively. I am new at dealing with macros and was wondering if it is even possible to write a macro able to do this. I have created a sample file with more detailed information about the way data is organized and how I would likely want the data to be organized after applying the macro. I would enormously appreciate your help in this since the real file I have to deal with contains about 60000 rows and is unlikely that I can organize all the data just by hand.

Thank you for your time,

Ale84

Example for excel forum help.xlsx

Hi

This was written for a dos machine, not a mac, but hopefully it will translate.

Make sure that you have a blank output sheet called sheet2 in your workbook.

Use the example file, and remove everything in Sheet1 below row 14, so you are only left with the data in the range A1:F13 (leave the "data before macro in row 1).

Then try

Sub aaa()
  Dim OutSH As Worksheet
  Set OutSH = Sheets("Sheet2")
  OutSH.Range("A1:C1").Value = Range("A2:C2").Value
  OutSH.Rows("2:2").NumberFormat = "@"
  Range("A3:C" & Cells(Rows.Count, 1).End(xlUp).Row).Copy Destination:=OutSH.Range("A3")
  Range("A:F").Replace what:="%7C", replacement:="~"
  Range("A:F").Replace what:="Exps=", replacement:=""
  Range("A:F").Replace what:="Samples=", replacement:=""
  Range("A:F").Replace what:="Scores=", replacement:=""
  Range("A:F").Replace what:="hour", replacement:=""
  
  For Each ce In Range("D3:D" & Cells(Rows.Count, 1).End(xlUp).Row)
    exparr = Split(ce.Value, "~")
    samparr = Split(ce.Offset(0, 1).Value, "~")
    scoresarr = Split(ce.Offset(0, 2).Value, "~")
    For ex = LBound(exparr) To UBound(exparr)
      lastcol = OutSH.Cells(1, Columns.Count).End(xlToLeft).Column
      sampsubarr = Split(samparr(ex), ",")
      scorsubarr = Split(scoresarr(ex), ",")
      For j = LBound(sampsubarr) To UBound(sampsubarr)
        If Evaluate("=sum((Sheet2!1:1 = """ & exparr(ex) & """) * (sheet2!2:2 = """ & sampsubarr(j) & """))") = 0 Then
          outcol = OutSH.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1).Column
          OutSH.Cells(1, outcol).Value = exparr(ex)
          OutSH.Cells(2, outcol).Value = CStr(sampsubarr(j))
          OutSH.Cells(ce.Row, outcol).Value = scorsubarr(j)
        Else
          outcol = Evaluate("=max((Sheet2!1:1 = """ & exparr(ex) & """)*(sheet2!2:2 = """ & sampsubarr(j) & """)*column(sheet2!1:1))")
          OutSH.Cells(ce.Row, outcol).Value = scorsubarr(j)
        End If
      Next j
    
    Next ex
  Next ce
  
  With OutSH
    For Each ce In .Range(.Range("D4"), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, .Cells(1, Columns.Count).End(xlToLeft).Column))
      If Len(ce) = 0 Then ce.Value = 0
    Next ce
    
    holder = ""
    For Each ce In .Range(.Range("D1"), .Cells(1, Columns.Count).End(xlToLeft))
      If ce <> holder Then
        holder = ce.Value
      Else
       ce.ClearContents
      End If
    Next ce
    
  End With
  
End Sub

It doesn't have any formatting or merged cells. I'm just trying to get the data correctly separated.

rylo

Amazing Rylo, thanks!