Hi, I put together the below macro that I am using to search for the text "Account:" and then apply X's to all characters except the last 4 in the cell to the right of the one that contains the text "Account:" - Then it prints to .pdf and has all columns on 1 page.
The changes I need to make are:
1. Have it first search for "Account:" and if that is not found, then search for "Account #" and if that is not found, then move the file to an "Exception Folder" (Right now it is only looking for "Account:" and will not move the file if it is not found)
2. I have folder "C:\All Docs\All" Docs where I have a list of excel docs, all formats, so it should be looking for .xls* - I need for this same macro to be ran on all excel docs in the folder.
3. Each output .pdf file should be saved to an output folder and the original excel file should be moved to a "Processed" folder once it has been processed, assuming it should not be moved to the "Exception" folder. Output file = "C:\All Docs\Output" and Processed Folder = "C:\All Docs\Processed"I have the naming convention already set up - should be the same file name with " - Redacted" added to the end
4. I would like for the same logic to to be applied to the document if there are multiple instances of "Account: " or "Account #" - I would prefer search over a loop through each cell because this will be running on a lot of files and run-time is a big factor.
5, I would like to save these .pdfs in a format that is friendly to OCR - I know that some .pdf formats will still allow for searches. If this is going to add a lot of time, then we should skip this as like I said, this program should have a pretty quick run time. But, I was thinking that since its currently in excel format, saving to a searchable .pdf may not take additional time.
Below is macro I am currently using - Thanks for any help!
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.PrintCommunication = False
On Error GoTo Error
Dim ShowChars As Integer
Dim RedactChar As String
Dim RedactString As String
Dim StringLength As Long
Dim RedactEnd As Boolean
Dim cell As Range
Dim Rng As Range
Dim LastC As String
Dim LastCRange As Range
Dim myCol As String
Dim FullRange As Range
Dim LR As Long
Dim LC As Long
Dim FileName As String
'FileName = ThisWorkbook.Path & "\" & ActiveWorkbook.Name
TestName = "C:\temp\" & ActiveWorkbook.Name & " - Redacted"
Set FullRange = ActiveSheet.UsedRange
LR = .Rows(.Rows.Count).Row
LC = .Columns(.Columns.Count).Column
myCol = GetColumnLetter(LC)
RedactEnd = True
ShowChars = 4
RedactChar = "X"
Cells.Find(What:="Account:", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
Set Rng = ActiveCell
StringLength = Len(Rng.Value)
SymbolString = Application.WorksheetFunction.Rept(RedactChar, StringLength - ShowChars)
If StringLength > ShowChars _
Then Rng.Value = SymbolString & Right(Rng.Value, ShowChars)
Rng.Characters(Start:=1, Length:=StringLength - 4).Font _
.FontStyle = "Bold"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
TestName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = False
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
Application.PrintCommunication = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Function GetColumnLetter(colNum As Long) As String
vArr = Split(Cells(1, colNum).Address(True, False), "$")
GetColumnLetter = vArr(0)