Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 6
Default Conditional alternating loop

I have the alternating loop functioning (code is ugly, see below), but
I don't know how to apply the condition and maintain the correct
CountWArt variable.
The condition is (If ActiveCell.Value = "" Then), skip this areas cell
and go to next areas cell without incrementing CountWArt. There is
delete all word art macro at the end of code for testing purposes. I'm
a beginner at this so any help will be appreciated, Thanks

Sub AddWordArt5()
Worksheets("Sheet1").Activate
Application.ScreenUpdating = False
Set BigRange = Application.Union(Range("G9:G13,N9:N13,U9:U13"), _
Range("G17:G21,N17:N21,U17:U21"), _
Range("G25:G29,N25:N29,U25:U29"), _
Range("G33:G37,N33:N37,U33:U37"))
Range("G9").Activate 'Select
''''''BigRangeCount = BigRange.Areas.Count
For Each Areas In BigRange
''''''For Count = 1 To BigRangeCount
Dim celTop As Long
celTop = ActiveCell.Top
Dim SH As Excel.Shape
'Alternates between text "A" and "B"
If fVBAIsEven(CountWArt) = True Then
Set SH = ActiveSheet.Shapes.AddTextEffect(TextEffect6,
_
"A", "Arial Black", 20#, _
False, False, 21.75, celTop)
End If
If fVBAIsEven(CountWArt) = False Then
Set SH = ActiveSheet.Shapes.AddTextEffect(TextEffect6,
_
"B", "Arial Black", 20#, _
False, False, 21.75, celTop)
End If
With SH
.Height = 25
.Width = 22
.Fill.Visible = True
.Fill.Solid
If .TextEffect.Text = "A" Then _
.Fill.ForeColor.SchemeColor = 10 '4 blue 10 Red
If .TextEffect.Text = "B" Then _
.Fill.ForeColor.SchemeColor = 4 '4 blue 10 Red
.Fill.Transparency = 0#
.Line.Weight = 0.75
.Line.DashStyle = 1
.Line.Style = 1
.Line.Transparency = 0#
.Line.Visible = True
If .TextEffect.Text = "A" Then _
.Line.ForeColor.SchemeColor = 10 '4 blue 10 Red
If .TextEffect.Text = "B" Then _
.Line.ForeColor.SchemeColor = 4 '4 blue 10 Red
.Line.BackColor.RGB = RGB(255, 255, 255)
.LockAspectRatio = False
.ZOrder BringToFront
.Left = Selection.Left
.IncrementLeft 19
.IncrementTop 11
End With
'First row/column ranges
If CountWArt <= 3 Then
ActiveCell.Offset(1, 0).Activate
End If
If CountWArt = 4 Then
ActiveCell.Offset(-4, 7).Activate
End If
If CountWArt 4 And CountWArt <= 8 Then
ActiveCell.Offset(1, 0).Activate
End If
If CountWArt = 9 Then
ActiveCell.Offset(-4, 7).Activate
End If
If CountWArt 9 And CountWArt <= 13 Then
ActiveCell.Offset(1, 0).Activate
End If
'Second row/column ranges
If CountWArt = 14 Then
ActiveCell.Offset(4, -14).Activate
End If
If CountWArt 14 And CountWArt <= 18 Then
ActiveCell.Offset(1, 0).Activate
End If
If CountWArt = 19 Then
ActiveCell.Offset(-4, 7).Activate
End If
If CountWArt 19 And CountWArt <= 23 Then
ActiveCell.Offset(1, 0).Activate
End If
If CountWArt = 24 Then
ActiveCell.Offset(-4, 7).Activate
End If
If CountWArt 24 And CountWArt <= 28 Then
ActiveCell.Offset(1, 0).Activate
End If
'Third row/column ranges
If CountWArt = 29 Then
ActiveCell.Offset(4, -14).Activate
End If
If CountWArt 29 And CountWArt <= 33 Then
ActiveCell.Offset(1, 0).Activate
End If
If CountWArt = 34 Then
ActiveCell.Offset(-4, 7).Activate
End If
If CountWArt 34 And CountWArt <= 38 Then
ActiveCell.Offset(1, 0).Activate
End If
If CountWArt = 39 Then
ActiveCell.Offset(-4, 7).Activate
End If
If CountWArt 39 And CountWArt <= 43 Then
ActiveCell.Offset(1, 0).Activate
End If
'Fourth row/column ranges

If CountWArt = 44 Then
ActiveCell.Offset(4, -14).Activate
End If
If CountWArt 44 And CountWArt <= 48 Then
ActiveCell.Offset(1, 0).Activate
End If
If CountWArt = 49 Then
ActiveCell.Offset(-4, 7).Activate
End If
If CountWArt 49 And CountWArt <= 53 Then
ActiveCell.Offset(1, 0).Activate
End If
If CountWArt = 54 Then
ActiveCell.Offset(-4, 7).Activate
End If
If CountWArt 54 And CountWArt <= 58 Then
ActiveCell.Offset(1, 0).Activate
End If

CountWArt = CountWArt + 1
Next Areas
''''''Next Count
Application.ScreenUpdating = True
End Sub

Function fVBAIsEven(ByVal lngNumber As Long) As Boolean
fVBAIsEven = (lngNumber \ 2 = lngNumber / 2)
End Function

'Deletes all WordArt from sheet
Sub DeleteWordArt()
Dim shp As Shape
Application.ScreenUpdating = False
For Each shp In ActiveSheet.Shapes
If Left(shp.Name, 7) = "WordArt" Then shp.Delete
Next shp
Application.ScreenUpdating = True
End Sub
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
alternating format BorisS Excel Discussion (Misc queries) 2 April 12th 09 04:49 PM
Conditional formatting similar to shading alternating rows Conan Kelly Excel Worksheet Functions 10 August 22nd 06 11:13 PM
Adding a loop to conditional delete code maw via OfficeKB.com New Users to Excel 21 August 15th 06 04:11 PM
how do I use conditional formatting for alternating cell shading? Exceluser Excel Worksheet Functions 3 February 12th 06 04:23 AM
Conditional Lookup and copy loop between worksheets David S[_3_] Excel Programming 1 September 30th 03 02:10 AM


All times are GMT +1. The time now is 01:14 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"