Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 47
Default Worksheet loop not replacing new text

I have code that looks at Master Events worksheet and populates an array of
worksheets according to text style.

Where I find a glitch is when something on the Master Events sheet is
deleted, it isn't getting deleted on the other worksheet(s)

Code as follows:

Sub UpdateWorksheets()

'Sheets(Array("Retail", "Community", "Workplace", "Corporate", "LA
Bold", "Durham Italic", "DC Bold Italic")).Select
'Sheets("Retail").Activate
'Application.Run "'2007 calendar.xls'!ClearCalendarSheets"


Dim i As Integer
Dim myCell As Range

Dim Erase1 As Boolean
Dim Erase2 As Boolean
Dim Erase3 As Boolean
Dim Erase4 As Boolean
Dim Erase5 As Boolean
Dim Erase6 As Boolean
Dim Erase7 As Boolean

For Each myCell In Worksheets("2008 Master
Events").Range("B5:H9,B14:H18,B23:H28,B33:H37,B42: H46,B51:H56,B61:H65,B70:H74,B79:H83,B88:H92,B97:H1 01,B106:H110")

Erase1 = True
Erase2 = True
Erase3 = True
Erase4 = True
Erase5 = True
Erase6 = True
Erase7 = True

For i = 1 To Len(myCell.Value)
If myCell.Characters(Start:=i, Length:=1).Font.ColorIndex = -4105 Then
If Erase1 = True Then
Worksheets("Corporate").Range(myCell.Address).Clea rContents
Erase1 = False
End If
Worksheets("Corporate").Range(myCell.Address).Valu e = _
Worksheets("Corporate").Range(myCell.Address).Valu e &
Mid(myCell.Value, i, 1)
End If

If myCell.Characters(Start:=i, Length:=1).Font.ColorIndex = 3 Then
If Erase2 = True Then
Worksheets("Retail").Range(myCell.Address).ClearCo ntents
Erase2 = False
End If
Worksheets("Retail").Range(myCell.Address).Value = _
Worksheets("Retail").Range(myCell.Address).Value & Mid(myCell.Value,
i, 1)
End If

If myCell.Characters(Start:=i, Length:=1).Font.ColorIndex = 11 Then
If Erase3 Then
Worksheets("Community").Range(myCell.Address).Clea rContents
Erase3 = False
End If
Worksheets("Community").Range(myCell.Address).Valu e = _
Worksheets("Community").Range(myCell.Address).Valu e &
Mid(myCell.Value, i, 1)
End If

If myCell.Characters(Start:=i, Length:=1).Font.ColorIndex = 10 Then
If Erase4 Then
Worksheets("Workplace").Range(myCell.Address).Clea rContents
Erase4 = False
End If
Worksheets("Workplace").Range(myCell.Address).Valu e = _
Worksheets("Workplace").Range(myCell.Address).Valu e &
Mid(myCell.Value, i, 1)
End If

If myCell.Characters(Start:=i, Length:=1).Font.FontStyle = "Bold" Then
If Erase5 Then
Worksheets("LA Bold").Range(myCell.Address).ClearContents
Erase5 = False
End If
Worksheets("LA Bold").Range(myCell.Address).Value = _
Worksheets("LA Bold").Range(myCell.Address).Value & Mid(myCell.Value,
i, 1)
End If

If myCell.Characters(Start:=i, Length:=1).Font.FontStyle = "Italic" Then
If Erase6 Then
Worksheets("Durham Italic").Range(myCell.Address).ClearContents
Erase6 = False
End If
Worksheets("Durham Italic").Range(myCell.Address).Value = _
Worksheets("Durham Italic").Range(myCell.Address).Value &
Mid(myCell.Value, i, 1)
End If

If myCell.Characters(Start:=i, Length:=1).Font.FontStyle = "Bold Italic"
Then
If Erase7 Then
Worksheets("DC Bold Italic").Range(myCell.Address).ClearContents
Erase7 = False
End If
Worksheets("DC Bold Italic").Range(myCell.Address).Value = _
Worksheets("DC Bold Italic").Range(myCell.Address).Value &
Mid(myCell.Value, i, 1)
End If

Next i
Next myCell
MsgBox "All sheets have been updated!"
End Sub
--
Thank you,

scrowley(AT)littleonline.com
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
replacing a worksheet Kris Excel Discussion (Misc queries) 2 February 2nd 09 06:02 PM
Macro - Fixed text code needs replacing with variable text steven.holloway Excel Discussion (Misc queries) 3 July 22nd 08 03:57 PM
replacing value in formula from outside worksheet? Mike[_4_] Excel Discussion (Misc queries) 4 March 24th 08 10:17 PM
Replacing a corrupt worksheet Steve Excel Worksheet Functions 0 September 17th 07 11:20 PM
replacing text in all cells with existing text plus something avi2001 Excel Discussion (Misc queries) 2 November 2nd 05 04:29 PM


All times are GMT +1. The time now is 02:51 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"