R
robin.coe
I'm new to VBA and a first time user to this group. I am having a
problem formatting a created workbook. My code accesses 1 workbook to
pull selected information into a new workbook with multiple worksheets.
Some of the data that is pulled into the workbook has cells with text
in them and colorindex =1 (black). I need to remove the text in the
cell and remove the colorindex.
I have written code that successfully does this for the 1st worksheet
but it will not work on more than one worksheet. I each worksheet as a
private sub that is then called. Below is the code from one worksheet.
Any help with what is wrong in my code would be appreciated.
Thanks!
Robin
Private Sub DiscountsSurcharges()
Dim strStart As String
Dim strStartingCell As String
Dim strEnd As String
Dim strEndingCell As String
Dim intStartRowOffset As Integer
Dim intEndRowOffset As Integer
Dim strColumn As String
wbCRD.Worksheets("Discounts & Surcharges").Activate
Range("B1").Activate
If strChannel = "Agency" Then
strStart = "UPP (10)"
intStartRowOffset = 0
strEnd = "Discounts and Surcharges print on the declarations
page as follows:"
intEndRowOffset = -2
strColumn = "AE"
Else
strStart = "Discounts And Surcharges By Underwriting Tier"
intStartRowOffset = 2
strEnd = "Group D Discount - Does Not Vary by Tier"
intEndRowOffset = 15
strColumn = "Z"
End If
strStartingCell = FindAddress(strStart, intStartRowOffset)
'Replacing the column name in the address
strEndingCell = Replace(FindAddress(strEnd, intEndRowOffset), "B",
strColumn)
Range(strStartingCell, strEndingCell).Select
Selection.Copy
wbThisWorkbook.Activate
Worksheets("Discounts & Surcharges").Activate
Worksheets("Discounts & Surcharges").Range("A8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select
Columns("A:A").ColumnWidth = 4.14
Columns("V:V").ColumnWidth = 9.86
Range("A1").Activate
Application.FindFormat.Interior.ColorIndex = 1
Application.ReplaceFormat.Interior.ColorIndex = xlNone
Cells.Replace What:="", Replacement:=" ", LookAt:=xlPart,
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=True,
ReplaceFormat:=True
With Application.FindFormat.Font
.Strikethrough = True
.Subscript = False
End With
Application.FindFormat.Interior.ColorIndex = xlNone
With Application.ReplaceFormat.Font
.Strikethrough = False
.Subscript = False
End With
Cells.Replace What:="", Replacement:=" ", LookAt:=xlPart,
SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True,
ReplaceFormat:=True
Cells.Select
Selection.Interior.ColorIndex = xlNone
End Sub
problem formatting a created workbook. My code accesses 1 workbook to
pull selected information into a new workbook with multiple worksheets.
Some of the data that is pulled into the workbook has cells with text
in them and colorindex =1 (black). I need to remove the text in the
cell and remove the colorindex.
I have written code that successfully does this for the 1st worksheet
but it will not work on more than one worksheet. I each worksheet as a
private sub that is then called. Below is the code from one worksheet.
Any help with what is wrong in my code would be appreciated.
Thanks!
Robin
Private Sub DiscountsSurcharges()
Dim strStart As String
Dim strStartingCell As String
Dim strEnd As String
Dim strEndingCell As String
Dim intStartRowOffset As Integer
Dim intEndRowOffset As Integer
Dim strColumn As String
wbCRD.Worksheets("Discounts & Surcharges").Activate
Range("B1").Activate
If strChannel = "Agency" Then
strStart = "UPP (10)"
intStartRowOffset = 0
strEnd = "Discounts and Surcharges print on the declarations
page as follows:"
intEndRowOffset = -2
strColumn = "AE"
Else
strStart = "Discounts And Surcharges By Underwriting Tier"
intStartRowOffset = 2
strEnd = "Group D Discount - Does Not Vary by Tier"
intEndRowOffset = 15
strColumn = "Z"
End If
strStartingCell = FindAddress(strStart, intStartRowOffset)
'Replacing the column name in the address
strEndingCell = Replace(FindAddress(strEnd, intEndRowOffset), "B",
strColumn)
Range(strStartingCell, strEndingCell).Select
Selection.Copy
wbThisWorkbook.Activate
Worksheets("Discounts & Surcharges").Activate
Worksheets("Discounts & Surcharges").Range("A8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select
Columns("A:A").ColumnWidth = 4.14
Columns("V:V").ColumnWidth = 9.86
Range("A1").Activate
Application.FindFormat.Interior.ColorIndex = 1
Application.ReplaceFormat.Interior.ColorIndex = xlNone
Cells.Replace What:="", Replacement:=" ", LookAt:=xlPart,
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=True,
ReplaceFormat:=True
With Application.FindFormat.Font
.Strikethrough = True
.Subscript = False
End With
Application.FindFormat.Interior.ColorIndex = xlNone
With Application.ReplaceFormat.Font
.Strikethrough = False
.Subscript = False
End With
Cells.Replace What:="", Replacement:=" ", LookAt:=xlPart,
SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True,
ReplaceFormat:=True
Cells.Select
Selection.Interior.ColorIndex = xlNone
End Sub