Excel formula or SQL script that would put bulk te

Question

I have a SQL database of illnesses (Records of 9,000) but the illnesses are copy-pasted into a single field and arranged in numbers. From here we always extract to Excel to manipulate the data. My problem now is to put these illnesses into separate cell compartment in excel so that we can filter it properly. I have only tried the Text-to-Column in Excel but it does not do the job.

Example:

And this is what I'm trying to achieve:

I hope it makes sense. Thank you.

Answer 1

This is possible in Get&Transform if you're on a recent version of Excel.

Get Data from range

Right Click the Column>Split Column>By Delimiter

In advanced options you can split by row and get the "new line" character i.e. cr/lf

Answer 2

Comorbidity

Intro

Wikipedia: In medicine, comorbidity is the presence of one or more additional diseases or disorders co-occurring with (that is, concomitant or concurrent with) a primary disease or disorder; in the countable sense of the term, a comorbidity (plural comorbidities) is each additional disorder or disease.

The Code

Beware: There is no error handling, so if something goes wrong just don't save anything. Close without saving and try again.
The code was tested and works fine with Excel 2003 and should work fine with all newer versions, too.
The code blocks starting with ' str1 = are just for debugging, a kind of 'subtotals' and can be deleted if you wish.

Sub Comorbidities()
  'Description
    'Writes the contents of cell values with several rows (per cell) to a new
    'worksheet each row in a seperate row. For this to work the worksheet with
    'the 'several row cells values' has to be active (selected).

'-- CUSTOMIZE BEGIN --------------------
  Const cStrHeader As String = "Comorbidities" 'Header
  Const cLoRow As Long = 2 'Starting row of initial data
  Const cStrColumn As String = "T" 'Column of initial data

  Const cLoRowResult As Long = 2 'Starting row of resulting data
  Const cStrColumnResult As String = "A" 'Column of resulting data
'-- CUSTOMIZE END ----------------------

  Dim oRng As Range 'Initial Range
  Dim oRngResult As Range 'Resulting Range

  Dim arrRng As Variant 'Array containing the initial data pasted from the range
  Dim arrSplit As Variant 'Array containing the rows inside a cell
  Dim arrData() As Variant 'Array containing the resulting data

  Dim loData As Long 'Count of all rows
  Dim loRng As Long 'Counter
  Dim loArr As Long 'Counter
  Dim iSplit As Integer 'Counter

  Dim str1 As String 'Debug String
  Dim lo1 As Long 'Debug Counter

  'Determine the range to be processed
  Set oRng = Range(Cells(cLoRow, cStrColumn), _
      Cells(Cells(Rows.Count, cStrColumn).End(xlUp).Row, cStrColumn))
  'Paste range into array
  arrRng = oRng
  Set oRng = Nothing 'Release the variable, initial data is in arrRng.

'Now arrays are taking over

'  str1 = "arrRng"
'  For lo1 = LBound(arrRng) To UBound(arrRng)
'      str1 = str1 & vbCrLf & lo1 & ". " & arrRng(lo1, 1)
'  Next
'  Debug.Print str1

  'Counting data - split each cells value and add to sum (loData)

  'Reading data from arrRng.
  For loRng = LBound(arrRng) To UBound(arrRng)
    'Splitting arrSplit by Chr(10)
    arrSplit = Split(arrRng(loRng, 1), Chr(10))
    loData = loData + UBound(arrSplit) + 1  '+ 1 i.e. arrSplit is 0-based.
  Next

  'Redeclare arrData using the result of the counting (loData).
  ReDim Preserve arrData(1 To loData, 1 To 1)

  'Reading data from arrRng.
  For loRng = LBound(arrRng) To UBound(arrRng)
    'Splitting arrSplit by Chr(10).
    arrSplit = Split(arrRng(loRng, 1), Chr(10))

'  str1 = "arrSplit"
'  For lo1 = LBound(arrSplit) To UBound(arrSplit)
'      str1 = str1 & vbCrLf & lo1 + 1 & ". " & arrSplit(lo1)
'  Next
'  Debug.Print str1

    'Writing arrSplit data to arrData.
    For iSplit = LBound(arrSplit) To UBound(arrSplit)
      loArr = loArr + 1
      arrData(loArr, 1) = arrSplit(iSplit)
    Next

    Erase arrSplit 'Is repeatedly newly created to write data to arrData.

'  str1 = "arrData"
'  For lo1 = LBound(arrData) To UBound(arrData)
'      str1 = str1 & vbCrLf & lo1 & ". " & arrData(lo1, 1)
'  Next
'  Debug.Print str1

  Next

  Erase arrRng 'No longer needed, resulting data is in arrData.

'  str1 = "arrData"
'  For lo1 = LBound(arrData) To UBound(arrData)
'      str1 = str1 & vbCrLf & arrData(lo1, 1)
'  Next
'  Debug.Print str1

'Output to new worksheet

  'Add a new worksheet positioned after the initial worksheet.
  Worksheets.Add After:=ActiveSheet
  'Determine the resulting range in the new worksheet.
  Set oRngResult = Range(Cells(1, 1), Cells(loData, 1))
  'Paste data into range
  oRngResult = arrData

  Erase arrData 'No longer needed, all data is in oRngResult.

  Set oRngResult = Nothing 'Release the variable, all data is in the worksheet.

  'Write Header
  Cells(cLoRowResult - 1, cStrColumnResult).Value = cStrHeader

End Sub

Some additional info

How to put more lines into one cell

You have to hold the left ALT key and press enter after each line.

How I got the delimiter

When you go into a cell (click in the formula bar) e.g. cell 'A1' with more lines (bulk data), you select the end of a line expanding over the 'invisible' kind of 'space looking' character right after the 'visible' part and copy it. Then paste it into another cell e.g. A2. Now in e.g. cell A3 write the formula =CODE(A2)and the result will be 10. So in VBA this means you choose this character by using the Chr Function: Chr(10) (in Excel this is =CHAR(10). BTW the character is called Line Feed (LF) or New Line (NL). For other character codes look here.

Answer 3

Comorbidity 2.0

Intro

Wikipedia: In medicine, comorbidity is the presence of one or more additional diseases or disorders co-occurring with (that is, concomitant or concurrent with) a primary disease or disorder; in the countable sense of the term, a comorbidity (plural comorbidities) is each additional disorder or disease.

Since you couldn't get the first script to work I could only conclude that you might have a different line delimiter than the Line Feed at the end of each line in the multi-line cells. So I wrote an improved version of the whole thing and added a function to determine the delimiter for each cell. Now you only have to select a column e.g. A, B, or T (in your sample picture) etc. in the customize section of the code:

'-- CUSTOMIZE BEGIN --------------------
  Const cStrColumn As String = "T" '<-- ***COLUMN IN HERE***

  Const cStrColumnResult As String = "A" 'Resulting Data Column
  Const cLoRow As Long = 0 '0 to use the first row of the initial data range.
'-- CUSTOMIZE END ----------------------

... and the code does the rest itself.

The Code

Option Explicit

'-------------------------------------------------------------------------------
Sub MultilineCellExtractor()
'-------------------------------------------------------------------------------
'Description
  'Copies the contents of each cell of a specified COLUMN in a worksheet,
  'skipping blank cells and converting multiple lines in cells each to a new
  'cell, and returns the result in a COLUMN of a newly created worksheet.
'Arguments as constants
  'cStrColumn
    'The Column of the Initial Data in ThisWorkbook's ActiveSheet
  'cStrColumnResult
    'The Column of the Resulting Data in a Newly to be Created Worksheet
  'cLoRow
    'The First Row of the Resulting Data in the Newly Created Worksheet
'Returns
  'A new worksheet with a column of the processed data.
'Usage
  'Open the workbook to be processed. Go to VBE and insert a new module. Copy
  'this script ('MultilineCellExtractor') and the function 'FirstNonPrintable'
  'and paste them into the module. Edit the 'customize section' to fit your
  'needs. Exit VBE and start the Run Macro Dialog (Play Button). DoubleClick or
  'select 'MultilineCellExtractor' and click Run to execute.
'Remarks
  'If there is no data in the column to be processed a message pops up (the only
  'error handling done so far). If there are no multiline cells, the data is
  'just copied while skipping the blanks.
  'There can be no damage done using this script in the previously described way
  'because the worksheet is only to be READ from, and the result is always
  'pasted into a NEW worksheet.

'-------------------------------------------------------------------------------
'-- CUSTOMIZE BEGIN --------------------
  Const cStrColumn As String = "T" 'Initial Data Column

  Const cStrColumnResult As String = "A" 'Resulting Data Column
  Const cLoRow As Long = 0 '0 to use the first row of the initial data range.
'-- CUSTOMIZE END ----------------------

'-------------------------------------------------------------------------------
  Dim oRng As Range 'Initial Colum, Initial Range, Resulting Range

  Dim arrRng As Variant 'Array Containing the Initial Data Range (Column)
  Dim arrSplit As Variant 'Array Containing the Cell Lines
  Dim arrData() As Variant 'Array Containing the Resulting Data Range (Column)

  Dim loRow1 As Long 'First Row of the Initial Data Range (Column)
  Dim loRow2 As Long 'Last Row of the Initial Data Range (Column)
  Dim loRowResult As Long 'First Row of the Resulting Data Range (Column)

  Dim loRng As Long 'Initial Array Rows Counter
  Dim iSplit As Integer 'Multiline Cell Lines Counter
  Dim loData As Long 'Resulting Array(Range) Rows Calculator and Counter

  Dim strRng As String 'Initial Data Reader: Shortcut for arrRng(loRng, 1).

  Dim str1 As String 'Debug String Writer
  Dim lo1 As Long 'Debug String Array Data Counter

'-------------------------------------------------------------------------------
  'Column of Initial Data
    'Needed to calculate first and last rows of data.
  Set oRng = ThisWorkbook.ActiveSheet.Range(cStrColumn & ":" & cStrColumn)
  'First Row Containing Data
  On Error Resume Next
    loRow1 = oRng.Find(What:="*", After:=Cells(Rows.Count, cStrColumn), _
        LookIn:=xlValues, LookAt:=xlPart, _
        SearchOrder:=xlByRows, SearchDirection:=xlNext).Row
    If Err Then
      MsgBox "You have probably selected a column with no data."
      GoTo ProcedureExit
    End If
  'Last Row Containing Data
  loRow2 = oRng.Find(What:="*", After:=Cells(1, cStrColumn), _
    LookIn:=xlValues, LookAt:=xlPart, _
    SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  'Calculate Initial Range
  Set oRng = ThisWorkbook.ActiveSheet.Range(Cells(loRow1, cStrColumn), _
      Cells(loRow2, cStrColumn))

'  str1 = "Calculate Initial Range (Results):"
'  str1 = str1 & vbCrLf & Space(2) & "loRow1 = " & loRow1
'  str1 = str1 & vbCrLf & Space(2) & "loRow2 = " & loRow2
'  str1 = str1 & vbCrLf & Space(2) & "oRng.Address: " & oRng.Address
'  Debug.Print str1 & vbCrLf

  'Paste range into array
  arrRng = oRng
  Set oRng = Nothing 'Release the variable, initial data is in arrRng.

'  str1 = "arrRng Contents:"
'  For lo1 = LBound(arrRng) To UBound(arrRng)
'      str1 = str1 & vbCrLf & Space(2) & lo1 & ". " & arrRng(lo1, 1)
'  Next
'  Debug.Print str1 & vbCrLf

'-------------------------------------------------------------------------------
'Now arrays are taking over

  'Count data in arrRng to calculate size of arrData.
  For loRng = LBound(arrRng) To UBound(arrRng)
    strRng = arrRng(loRng, 1)
    If strRng <> "" Then 'Not empty cell, continue.
      If FirstNonPrintable(strRng) > 0 Then 'Non printable character found.
        'Splitting arrSplit by 'FirstNonPrintable'
        arrSplit = Split(strRng, Chr(FirstNonPrintable(strRng)))
        loData = loData + UBound(arrSplit) + 1  '+ 1 i.e. arrSplit is 0-based.
       Else 'Nonprintable character not found.
        loData = loData + 1
      End If
'     Else 'Empty cell, do nothing.
    End If
  Next

  'Redeclare arrData using the result of the counting (loData).
  ReDim Preserve arrData(1 To loData, 1 To 1)

  'Reset counter for counting.
  loData = 0
  'Read data from arrRng and write to array.
  For loRng = LBound(arrRng) To UBound(arrRng)
    strRng = arrRng(loRng, 1)
    If strRng <> "" Then 'Not empty cell, continue.
      If FirstNonPrintable(strRng) > 0 Then 'Non printable character found.
        'Splitting arrSplit by 'FirstNonPrintable'
        arrSplit = Split(strRng, Chr(FirstNonPrintable(strRng)))
'
'  str1 = "arrSplit Contents:"
'  For lo1 = LBound(arrSplit) To UBound(arrSplit)
'      str1 = str1 & vbCrLf & Space(2) & lo1 + 1 & ". " & arrSplit(lo1)
'  Next
'  Debug.Print str1 & vbCrLf
'
        'Writing arrSplit data to arrData.
        For iSplit = LBound(arrSplit) To UBound(arrSplit)
          loData = loData + 1
          arrData(loData, 1) = arrSplit(iSplit)
        Next

        Erase arrSplit 'Is repeatedly newly created to write data to arrData.

       Else 'Nonprintable character not found.
        loData = loData + 1
        arrData(loData, 1) = strRng
      End If
'     Else 'Empty cell, do nothing.
    End If
  Next

  Erase arrRng 'No longer needed, resulting data is in arrData.
'
'  str1 = "arrData Contents:"
'  For lo1 = LBound(arrData) To UBound(arrData)
'      str1 = str1 & vbCrLf & Space(2) & lo1 & ". " & arrData(lo1, 1)
'  Next
'  Debug.Print str1
'
'-------------------------------------------------------------------------------
'Return data in new worksheet

  'Calculate the first row of data in the resulting worksheet.
  If cLoRow > 0 Then
    loRowResult = cLoRow 'Row as the constant in the 'customize section'.
   Else
    loRowResult = loRow1 'Same row as in the initial worksheet.
  End If
  'Add a new (resulting) worksheet positioned after the initial worksheet.
  ThisWorkbook.Worksheets.Add _
      After:=ActiveSheet 'The resulting worksheet is active now.
  'Calculate the resulting range in the new worksheet.
  Set oRng = ActiveSheet.Range(Cells(loRowResult, cStrColumnResult), _
      Cells(loRowResult + loData - 1, cStrColumnResult))
  'Paste data into the resulting range.
  oRng = arrData
  Erase arrData 'No longer needed, all data is in oRng.

'-------------------------------------------------------------------------------
ProcedureExit:
  Set oRng = Nothing 'Release the variable, all data is in the worksheet.

End Sub
'-------------------------------------------------------------------------------

'-------------------------------------------------------------------------------
Function FirstNonPrintable(StringToClean As String, _
    Optional Code0Position1String2 As Integer = 0) As Variant
'-------------------------------------------------------------------------------
'Description
  'Finds the first character in a string that is different from the character
  'at the same position in the cleaned version of the same string and returns
  'its code, position or string.
'Arguments
  'StringToClean (String)
    'The string to clean.
  'Code0Position1String2 (Integer)
    'Returns for
      '0, the character code (Asc) of the found character to be used with
        'the Chr function.
      '1, the position of the found character.
      '2, the found character.

  Dim strCleaned As String
  Dim loLen As Long

  strCleaned = WorksheetFunction.Clean(StringToClean)

  If StringToClean = strCleaned Then Exit Function

  For loLen = 1 To Len(StringToClean)
    If Mid(StringToClean, loLen, 1) <> Mid(strCleaned, loLen, 1) Then
      Select Case Code0Position1String2
        Case 0
          FirstNonPrintable = Asc(Mid(StringToClean, loLen, 1))
        Case 1
          FirstNonPrintable = loLen
        Case 2
          FirstNonPrintable = Mid(StringToClean, loLen, 1)
      End Select
      Exit Function
    End If
  Next

End Function
'-------------------------------------------------------------------------------

Some additional info

To put more lines into a cell you have to hold the left ALT key and press enter after each line.

For character codes look here.