Sub a__Initial_Letters_Run_LAC_SRC_LTR2_File()
Dim SrcWbk As Workbook
Dim DestWbk As Workbook
Dim file_name As Variant
Set DestWbk = ThisWorkbook
file_name = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", title:="Select the Offer Letters Excel file")
If file_name = "False" Then Exit Sub
Set SrcWbk = Workbooks.Open(file_name)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Table 2").Select
Sheets("Table 2").Copy Before:=Sheets(2)
Sheets("Table 2 (2)").Select
Sheets("Table 2 (2)").Move Before:=Sheets(1)
Sheets("Table 2 (2)").Select
Sheets("Table 2 (2)").Name = "MASTER"
Cells.Select
Selection.Delete Shift:=xlUp
Range("A1").Select
Dim ActRng As Range
Dim ActWsName As String
Dim ActAddress As String
Dim Ws As Worksheet
On Error Resume Next
Set ActRng = Application.ActiveCell
ActWsName = Application.ActiveSheet.Name
ActAddress = ActRng.Address(False, False)
Application.ScreenUpdating = False
xIndex = 0
For Each Ws In Application.Worksheets
If Ws.Name <> ActWsName Then
ActRng.Offset(xIndex, 0).Value = "='" & Ws.Name & "'!" & ActAddress
xIndex = xIndex + 1
End If
Next
Application.ScreenUpdating = True
Columns("A:A").Select
Selection.Copy
Columns("B:B").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Cells.Select
Range("B2").Activate
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Dim sht As Worksheet
Dim fndList As Variant
Dim rplcList As Variant
Dim x As Long
fndList = Array("To: ")
rplcList = Array("")
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="1", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
1), Array(6, 1)), TrailingMinusNumbers:=True
Columns("B:B").Select
Selection.ClearContents
'Loop through each item in Array lists
For x = LBound(fndList) To UBound(fndList)
'Loop through each worksheet in ActiveWorkbook
For Each sht In ActiveWorkbook.Worksheets
sht.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Next sht
Next x
'Loop through each item in Array lists
For x = LBound(fndList) To UBound(fndList)
'Loop through each worksheet in ActiveWorkbook
For Each sht In ActiveWorkbook.Worksheets
sht.Cells.Replace What:=fndList(x), Replacement:=rplcList(x), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Next sht
Next x
Range("C1").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-2],"" "",RC[-1],"".pdf"")"
Range("C1:C600").Select
Selection.FillDown
Columns("C:C").EntireColumn.AutoFit
Range("D1").Select
ActiveCell.FormulaR1C1 = "=""""""""&RC[-1]&"""""""""
Range("D1:D800").Select
Selection.FillDown
Columns("D:D").Select
Selection.Copy
Columns("E:E").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("C:D").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("C:C").EntireColumn.AutoFit
Range("E1").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(""ren "",RC[-1], "" "",RC[-2])"
Range("E2").Select
Columns("E:E").EntireColumn.AutoFit
Range("E1").Select
Range("E1:E800").Select
Selection.FillDown
Columns("E:E").EntireColumn.AutoFit
Columns("D:D").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("E1").Select
ActiveCell.FormulaR1C1 = "=""""""""&RC[-1]&"""""""""
Range("E1:E600").Select
Selection.FillDown
Columns("F:F").Select
Selection.ColumnWidth = 80
Columns("D:D").Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Columns("A:A").EntireColumn.AutoFit
Columns("A:A").Select
Selection.Replace What:="9*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="8*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="7*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="6*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="5*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="4*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="3*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="2*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="1*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="PO*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="Date Home Phone Work Phone*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="Vice President Approval Signature or designee Date*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="P.O.*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="p.o.*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="Po Box*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="Instructor*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="" & Chr(10) & "", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
ReplaceFormat:=False
Columns("A").SpecialCells(xlBlanks).EntireRow.Delete
Range(Range("A1"), Range("A1").End(xlDown)).Select
Dim Rng As Range
Set Rng = Selection
For Each Cell In Rng
Cell.Value = Trim(Cell)
Next Cell
Columns("A:A").EntireColumn.AutoFit
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlTop
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Dim Rnge As Range
Dim WorkRnge As Range
On Error Resume Next
Set WorkRnge = Application.Selection
Application.ScreenUpdating = False
Do
Set Rnge = WorkRnge.Find("0", LookIn:=xlValues)
If Not Rnge Is Nothing Then
Rnge.EntireRow.Delete
End If
Loop While Not Rnge Is Nothing
Application.ScreenUpdating = True
Dim lastRowA As Long
lastRowA = Cells(Rows.Count, "A").End(xlUp).Row
Range("A1:A" & lastRowA).Select
Range("A1:A" & lastRowA).Copy
SrcWbk.Sheets("MASTER").Range("A1:A" & lastRowA).Copy DestWbk.Sheets("MASTER").Range("A3")
SrcWbk.Close False
End Sub