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

Maybe you could put a giant "for each/next" around your code:

dim wks as worksheet

for each wks in wbCRD.worksheets
wks.activate
'remove this line:
'wbCRD.Worksheets("Discounts & Surcharges").Activate
'your original code that does all the work here
next wks



wrote:

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

--

Dave Peterson

This worked really well, it now handles all worksheets with cells that
a colorindex =1.

However, I originally had code that replaced all font = strikethrough
with " ", this code no longer works. It appears that VBA will only
allow me to do one replace, either colorindex = 1 to xlnone or
strikethrough with blank.

I've tried placing the replace strikethrough code with the colorindex
code and that didn't work, I even tried creating a new sub routine but
that didn't work.

Any suggestions on this??

Robin

Are you trying to remove that formatting from cells that have both
..interior.colorindex = 1
and
..font.strikethrough = true

Option Explicit
Sub testme01()
Dim wks As Worksheet
For Each wks In ActiveWorkbook.Worksheets
With wks
Application.FindFormat.Clear
With Application.FindFormat
.Font.Strikethrough = True
.Interior.ColorIndex = 6
End With
With Application.ReplaceFormat
.Font.Strikethrough = False
.Interior.ColorIndex = xlNone
End With
.Cells.Replace What:="", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=True, _
ReplaceFormat:=True
End With
Next wks
End Sub

And I wouldn't replace "" with " ". I'd just use "" with "".

wrote:

This worked really well, it now handles all worksheets with cells that
a colorindex =1.

However, I originally had code that replaced all font = strikethrough
with " ", this code no longer works. It appears that VBA will only
allow me to do one replace, either colorindex = 1 to xlnone or
strikethrough with blank.

I've tried placing the replace strikethrough code with the colorindex
code and that didn't work, I even tried creating a new sub routine but
that didn't work.

Any suggestions on this??

Robin

--

Dave Peterson

No, they are 2 separate conditions. Condition 1 - remove text in cells
that have colorindex=1 and set the colorindex to xlnone and Condition 2
- remove text in cells that have strikethrough.

I was finally able to make it work. I had to do 2 individual loops and
clear the find format out before starting the 2nd loop. Might not be
the most efficient way but it does work.

Thanks for your help.

That's the way I'd do it, too.

Glad you got it working.

wrote:

No, they are 2 separate conditions. Condition 1 - remove text in cells
that have colorindex=1 and set the colorindex to xlnone and Condition 2
- remove text in cells that have strikethrough.

I was finally able to make it work. I had to do 2 individual loops and
clear the find format out before starting the 2nd loop. Might not be
the most efficient way but it does work.

Thanks for your help.

--

Dave Peterson