View Single Post
 
Old 09-03-2014, 10:43 PM
excelledsoftware excelledsoftware is offline Windows 7 64bit Office 2003
IT Specialist
 
Join Date: Jan 2012
Location: Utah
Posts: 455
excelledsoftware will become famous soon enough
Default

Ok originally we were going for a code that would replace carriage returns in columns C and D. Based off of different workbooks this rule has changed. I have re-written the entire code to be more efficient and it will handle the first 10 columns. Hopefully this ends up working for every workbook in the specified folder. Let me know if this works out.
Code:
Option Explicit
Dim cwb As Workbook, ws As Worksheet, CheckCol As String

Sub RemoveAllCarriageReturns()
  'Goes through all files of a specified folder and removes all
  'carriage returns from Columns specified in ColArray
  
  Dim FolderString As String, StrFile As String, Confirm As String, wb As Workbook
  Dim ColArray As Variant, Arr As Integer
  
    Confirm = MsgBox("This code will replace all carriage returns and line breaks with a comma." & vbLf & _
    "This will be done to every single workbook within the folder that you specify." & vbLf & _
    "It is strongly recommended that you create the necessary backups before running this code." & vbLf & _
    "Do you wish to continue?", vbYesNo)
    
    If Confirm = vbNo Then End
    
    Set wb = ThisWorkbook
    ColArray = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J")
    FolderString = InputBox("Folder Location:")
    If FolderString = "" Then End
    
    'Set the file folder
    StrFile = Dir(FolderString & "/")
    
    Do While Len(StrFile) <> 0
      If InStr(1, StrFile, ".xl") <> 0 Then
        Set cwb = Workbooks.Open(FolderString & "/" & StrFile)
        Set ws = cwb.Worksheets(1)
        'Run function to clean up columns
        For Arr = 0 To 9
          LineBreakReplace (ColArray(Arr))
        Next Arr
        cwb.Save
        cwb.Close
      End If
      Set cwb = Nothing
      Set ws = Nothing
      StrFile = Dir()
    Loop
    
    MsgBox ("Complete")

End Sub
Function LineBreakReplace(CheckCol As String)

  Dim CheckRow As Long, CheckString As String, BadData As Variant
  Dim DblCommaGone As Boolean, TotalRows As Long, x As Byte
  
    'Find the Last Row
    TotalRows = ws.Range(CheckCol & "50000").End(xlUp).Row

    On Error GoTo 0 'Reset error handling and enter line breaks in the array
    BadData = Array(vbCr, vbLf, vbCrLf, Chr(10), Chr(13))
    
    'Clean Column
    For CheckRow = 1 To TotalRows
      CheckString = ws.Range(CheckCol & CheckRow).Value
      For x = 0 To 4
        If InStr(1, CheckString, BadData(x)) Then
          ws.Range(CheckCol & CheckRow).Value = Replace(CheckString, BadData(x), ",")
        End If
      Next x
    'Now clear the commas
      Do Until DblCommaGone = True
        CheckString = ws.Range(CheckCol & CheckRow).Value
        If InStr(1, CheckString, ",,") = 0 Then
          DblCommaGone = True
        Else
          ws.Range(CheckCol & CheckRow).Value = WorksheetFunction.Substitute(CheckString, ",,", ",")
        End If
      Loop
      DblCommaGone = False
    Next CheckRow

End Function
Reply With Quote