Microsoft Office Forums - View Single Post - [Solved] Run Script to remove carriage returns on certain columns

ryanjohnsond@gmail.com · 08-21-2014, 01:35 PM

Quote:

Originally Posted by excelledsoftware

Yes this code should do that.

Code:

Option Explicit
Sub RemoveLineBreaks()
  'Looks at row 1 to find 2 columns and then runs a script to remove
  'all line breaks from the range
  Dim CheckRow As Long, TotalRows As Long
  Dim BadData As Variant, x As Integer
  Dim ICol As Integer, NCol As Integer, CheckCol As Integer
  Dim CheckNstring As String, CheckIstring As String, CheckColString As String
  Dim NewNstring As String, NewIstring As String
  
  'Set the variables and find the needed columns
  
    TotalRows = Range("A50000").End(xlUp).Row
    On Error Resume Next

      End
    End If
    If NCol = 0 Then
      MsgBox ("Cannot find the term 'No.' in Row 1." & vbLf & "Please update and try again.")
      End
    End If
    
    On Error GoTo 0 'Reset error handling
    BadData = Array(vbCr, vbLf, vbCrLf, Chr(10), Chr(13))
    
    
    'Fix the column headers
    For CheckCol = 1 To 255
      CheckColString = Cells(1, CheckCol).Value
      For x = 0 To UBound(BadData)
        CheckColString = WorksheetFunction.Substitute(CheckColString, BadData(x), " ")
      Next x
      Cells(1, CheckCol).Value = Trim(CheckColString)
      If Cells(1, CheckCol).Value = "" Then Exit For 'Exit loop when there is no more data
      CheckColString = ""
    Next CheckCol

    'Check the 2 columns
    For CheckRow = 2 To TotalRows
      CheckIstring = Cells(CheckRow, ICol).Value
      CheckNstring = Cells(CheckRow, NCol).Value
      For x = 0 To UBound(BadData)
        CheckIstring = WorksheetFunction.Substitute(CheckIstring, BadData(x), ",")
        CheckNstring = WorksheetFunction.Substitute(CheckNstring, BadData(x), ",")
      Next x
      Cells(CheckRow, ICol).Value = CheckIstring
      Cells(CheckRow, NCol).Value = CheckNstring
      
      'Clean up Vars
      CheckIstring = ""
      CheckNstring = ""
      Debug.Print TotalRows - CheckRow & " Records Left."
    Next CheckRow
    
    MsgBox "Complete"
End Sub

My last code I posted before this replaced breaks with a space I forgot the comma so ignore that code and just use this one.

As for the multiple workbooks I will have a few more questions for you to get that set up but this code should run on any workbook no problem.

Let me know if you have any questions.

Thanks

How do I deal with a carriage return in the header? I didn't notice this, but on every file, the header is "items [carriage return] sheet", and "No. [carriage return] sheet".

To use your code I have to manually go into every header first and remove the carriage return so that your code can find header "items" and "no."

The header actually looks like this:

-------
items
sheet
-------

and

-------
no.
sheet
-------
What's the best way to deal with the carriage return that's forcing the words "sheet" to wrap down to the next line in the header cell?

Code:

    ICol = Range("1:1").Find("Items", LookAt:=xlWhole).Column
    NCol = Range("1:1").Find("No.", LookAt:=xlWhole).Column
    'Check if column numbers were found
    If ICol = 0 Then
      MsgBox ("Cannot find the term 'Items' in Row 1." & vbLf & "Please update and try again.")

*UPDATE. Another thought.
The headers in question are always the 2nd and 3rd column on row 9. It's ok if it replaces the header with a comma too. Just as long as I can remove the carriage returns on their entire column that would be fine. Like this example below:

e.g.,

Start at row 9
<pre>
col1 col2 col3
---- ------- -------
Pos. Items No.
sheet sheet
---- ------- -------
</pre>
and from there remove carriage and replace with comma.
<pre>
col1 col2 col3
---- -------------- -----------
Pos. Items,sheet No.,sheet
---- ------------- -----------
</pre>