title: Count lines of text in a cell
body: <p>I have an Excel spreadsheet of data for work that I need to split up in VBA.  A couple of columns have multiple lines of text and others do not.  I've figured out how to split the multiple lines of text, my problem is taking the column with a single line of text and copying it down.  For example:</p>
  
  <pre><code>Company_Name     Drug_1      Phase_2        USA
                   Drug_2      Discontinued 
                   Drug_3      Phase_1        Europe
                   Drug_4      Discontinued  
  </code></pre>
  
  <p>Below is the code I am using to split columns B &amp; C and then I can handle D manually, however I need column A to copy down into rows 2-4.  There's over 600 rows like this otherwise I would just do it manually.  (Note: I'm putting column B into A below, and column C into C)</p>
  
  <pre><code>Sub Splitter()
      Dim iPtr1 As Integer
      Dim iPtr2 As Integer
      Dim iBreak As Integer
      Dim myVar As Integer
      Dim strTemp As String
      Dim iRow As Integer
  
  'column A loop
      iRow = 0
      For iPtr1 = 1 To Cells(Rows.Count, 1).End(xlUp).Row
          strTemp = Cells(iPtr1, 1)
          iBreak = InStr(strTemp, vbLf)
          Range("C1").Value = iBreak
              Do Until iBreak = 0
              If Len(Trim(Left(strTemp, iBreak - 1))) &gt; 0 Then
                  iRow = iRow + 1
                  Cells(iRow, 2) = Left(strTemp, iBreak - 1)
              End If
              strTemp = Mid(strTemp, iBreak + 1)
              iBreak = InStr(strTemp, vbLf)
          Loop
          If Len(Trim(strTemp)) &gt; 0 Then
              iRow = iRow + 1
              Cells(iRow, 2) = strTemp
          End If
      Next iPtr1
  
  'column C loop
      iRow = 0
      For iPtr2 = 1 To Cells(Rows.Count, 3).End(xlUp).Row
          strTemp = Cells(iPtr2, 3)
          iBreak = InStr(strTemp, vbLf)
          Do Until iBreak = 0
              If Len(Trim(Left(strTemp, iBreak - 1))) &gt; 0 Then
                  iRow = iRow + 1
                  Cells(iRow, 4) = Left(strTemp, iBreak - 1)
              End If
              strTemp = Mid(strTemp, iBreak + 1)
              iBreak = InStr(strTemp, vbLf)
          Loop
          If Len(Trim(strTemp)) &gt; 0 Then
              iRow = iRow + 1
              Cells(iRow, 4) = strTemp
          End If
      Next iPtr2
  
  End Sub
  </code></pre>