Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
alternating format | Excel Discussion (Misc queries) | |||
Conditional formatting similar to shading alternating rows | Excel Worksheet Functions | |||
Adding a loop to conditional delete code | New Users to Excel | |||
how do I use conditional formatting for alternating cell shading? | Excel Worksheet Functions | |||
Conditional Lookup and copy loop between worksheets | Excel Programming |