![]() |
#22
|
|||
|
|||
![]()
OK I tested this a couple of times and it seems to work fine.
Keep in mind that this will change every single excel file in a folder so make sure to make a backup of the entire folder before running. This will replace the carriage return with a comma in the headers as well. If we need to fix that I will have to find out the exact text in those 2 headers but other than that it appears to work. Code:
Option Explicit Dim cwb As Workbook, ws As Worksheet Sub RemoveAllCarriageReturns() 'Goes through all files of a specified folder and removes all 'carriage returns from Columns C and D and replaces them with a comma 'Saves the workbook with the same name in the folder and moves to the next file. Dim FolderString As String, StrFile As String, Confirm As String, wb As Workbook 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 FolderString = InputBox("Folder Location:") If FolderString = "" Then End 'Set the file folder StrFile = Dir(FolderString & "/") Do While Len(StrFile) <> 0 If InStr(1, StrFile, ".xls") <> 0 Or InStr(1, StrFile, ".xlsm") <> 0 Then Workbooks.Open Filename:=StrFile Set cwb = ActiveWorkbook Debug.Print cwb.Name Set ws = cwb.Worksheets(1) LineBreakReplace cwb.Save cwb.Close End If Set cwb = Nothing Set ws = Nothing StrFile = Dir() Loop MsgBox ("Complete") End Sub Function LineBreakReplace() Dim CTotalRows As Long, DTotalRows As Long, TotalRows As Long, x As Byte Dim CheckRow As Long, CheckString As String, BadData As Variant 'Find the Last Row CTotalRows = ws.Range("C50000").End(xlUp).Row DTotalRows = ws.Range("D50000").End(xlUp).Row If CTotalRows > DTotalRows Then TotalRows = CTotalRows Else TotalRows = DTotalRows End If 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 C For CheckRow = 1 To TotalRows CheckString = ws.Range("C" & CheckRow).Value For x = 0 To 4 If InStr(1, CheckString, BadData(x)) Then ws.Range("C" & CheckRow).Value = Replace(CheckString, BadData(x), ",") End If Next x Next CheckRow 'Clean Column D For CheckRow = 1 To TotalRows CheckString = ws.Range("D" & CheckRow).Value For x = 0 To 4 If InStr(1, CheckString, BadData(x)) Then ws.Range("D" & CheckRow).Value = _ WorksheetFunction.Substitute(CheckString, BadData(x), ",") End If Next x Next CheckRow End Function Let me know how it works I will be happy to fix anything if there are issues. Thanks for this opportunity. |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
Alaska1 | Word | 1 | 01-14-2013 08:48 AM |
![]() |
sinbad | Word VBA | 6 | 02-27-2012 03:51 AM |
![]() |
revrossreddick | Word | 2 | 12-28-2011 01:33 PM |
Carriage Return Help | UCHelp | Word | 1 | 04-04-2010 10:11 PM |
![]() |
nam085 | Word | 1 | 03-04-2010 08:00 AM |