#31
|
|||
|
|||
Update
Try the enclosed Marco I used to run your code on the files in the directory. Basically, the third column (Stkz.Items) doesn't get updated by your latest code.
Please see the attached zip file. These are cleaned up files that are used. |
#32
|
|||
|
|||
Third Column? I thought we said just columns C and D that's exactly why your third column is not updating because I wrote it for Columns C and D. Below will work through a third column as well.
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, ".xl") <> 0 Then Set cwb = Workbooks.Open(FolderString & "/" & StrFile) 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 Dim DblCommaGone As Boolean, ETotalRows As Long 'Find the Last Row CTotalRows = ws.Range("C50000").End(xlUp).Row DTotalRows = ws.Range("D50000").End(xlUp).Row ETotalRows = ws.Range("E50000").End(xlUp).Row TotalRows = WorksheetFunction.Max(CTotalRows, DTotalRows, ETotalRows) 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 'Now clear the commas Do Until DblCommaGone = True CheckString = ws.Range("C" & CheckRow).Value If InStr(1, CheckString, ",,") = 0 Then DblCommaGone = True Else ws.Range("C" & CheckRow).Value = WorksheetFunction.Substitute(CheckString, ",,", ",") End If Loop DblCommaGone = False 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 'Now clear the commas Do Until DblCommaGone = True CheckString = ws.Range("D" & CheckRow).Value If InStr(1, CheckString, ",,") = 0 Then DblCommaGone = True Else ws.Range("D" & CheckRow).Value = WorksheetFunction.Substitute(CheckString, ",,", ",") End If Loop DblCommaGone = False Next CheckRow 'Clean Column E For CheckRow = 1 To TotalRows CheckString = ws.Range("E" & CheckRow).Value For x = 0 To 4 If InStr(1, CheckString, BadData(x)) Then ws.Range("E" & CheckRow).Value = _ WorksheetFunction.Substitute(CheckString, BadData(x), ",") End If Next x 'Now clear the commas Do Until DblCommaGone = True CheckString = ws.Range("E" & CheckRow).Value If InStr(1, CheckString, ",,") = 0 Then DblCommaGone = True Else ws.Range("E" & CheckRow).Value = WorksheetFunction.Substitute(CheckString, ",,", ",") End If Loop DblCommaGone = False Next CheckRow End Function |
#33
|
|||
|
|||
Quote:
For 34 files in one directory, everything ran beautifully, except for one file. Can you take a look at this one file and see what makes this one the exception? please see attached file below, "123 498 987 part name.xlsx" |
#34
|
|||
|
|||
The reason it didnt work on this one is because it is coded to go through columns C, D and E. These are in Columns A,B,C. We can change it to go through these columns but it may be easier to just insert 2 columns to the very left. Save it and then run the code.
|
#35
|
|||
|
|||
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 |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
stop carriage return or enter key in a table | Alaska1 | Word | 1 | 01-14-2013 08:48 AM |
Coding into a macro a carriage return | sinbad | Word VBA | 6 | 02-27-2012 03:51 AM |
Paragraph (carriage) return font size | revrossreddick | Word | 2 | 12-28-2011 01:33 PM |
Carriage Return Help | UCHelp | Word | 1 | 04-04-2010 10:11 PM |
Table of contents, remove spacing and put in 2 columns - need help urgently! | nam085 | Word | 1 | 03-04-2010 08:00 AM |