Need help consolidating VBA

andrewb90

andrewb90

Well-known Member
Joined
Dec 16, 2009
Messages
1,077
Hello,

I have this VBA code that I have been using, and I was just wondering if there was a way to consolidate it. It's rather long, and I haven't minded it until I made another addition and doubled the size. The only thing I need to do is make sure I am still able to edit it. (Sometimes, I get some code from some of the users here, more talented than me, and I don't understand one bit)

Here is the code:

Code: 
Sub weekbox1()
ActiveSheet.Unprotect "GOKU"
If Range("N14").Value < 6 Then
    Application.ScreenUpdating = False
    Rows("2:1001").Hidden = True
    ActiveSheet.DropDowns.Visible = False
    ActiveSheet.Pictures("err-1").Visible = False
    ActiveSheet.Pictures("err-2").Visible = False
    ActiveSheet.Pictures("err-3").Visible = False
    ActiveSheet.Pictures("err-4").Visible = False
    ActiveSheet.Pictures("err-5").Visible = False
    ActiveSheet.Pictures("DCHECK1").Visible = False
    ActiveSheet.Pictures("DCHECK2").Visible = False
    ActiveSheet.Pictures("DCHECK3").Visible = False
    ActiveSheet.Pictures("DCHECK4").Visible = False
    ActiveSheet.Pictures("DCHECK5").Visible = False
    ActiveSheet.Pictures("bad-1").Visible = False
    ActiveSheet.Pictures("bad-2").Visible = False
    ActiveSheet.Pictures("bad-3").Visible = False
    ActiveSheet.Pictures("bad-4").Visible = False
    ActiveSheet.Pictures("bad-5").Visible = False
    ActiveSheet.Shapes("start1a").Visible = True
    ActiveSheet.Shapes("start1b").Visible = False
    ActiveSheet.Shapes("start1c").Visible = False
    ActiveSheet.Shapes("start2a").Visible = False
    ActiveSheet.Shapes("start2b").Visible = False
    ActiveSheet.Shapes("start2c").Visible = False
    ActiveSheet.Shapes("start3a").Visible = False
    ActiveSheet.Shapes("start3b").Visible = False
    ActiveSheet.Shapes("start3c").Visible = False
    ActiveSheet.Shapes("start4a").Visible = False
    ActiveSheet.Shapes("start4b").Visible = False
    ActiveSheet.Shapes("start4c").Visible = False
    ActiveSheet.Shapes("start5a").Visible = False
    ActiveSheet.Shapes("start5b").Visible = False
    ActiveSheet.Shapes("start5c").Visible = False
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "Week 1"
    Rows("2:7").Hidden = False
    Rows("8:1000").Hidden = True
    ActiveSheet.Shapes.Range(Array("wbox1")).Select
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 1).font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    ActiveSheet.Shapes.Range(Array("wbox2")).Select
    Selection.ShapeRange.glow.Radius = 0
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 1).font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 0, 0)
        .Transparency = 0
        .Solid
    End With
    ActiveSheet.Shapes.Range(Array("wbox3")).Select
    Selection.ShapeRange.glow.Radius = 0
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 1).font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 0, 0)
        .Transparency = 0
        .Solid
    End With
    ActiveSheet.Shapes.Range(Array("wbox4")).Select
    Selection.ShapeRange.glow.Radius = 0
        With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 1).font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 0, 0)
        .Transparency = 0
        .Solid
    End With
    ActiveSheet.Shapes.Range(Array("wbox5")).Select
    Selection.ShapeRange.glow.Radius = 0
        With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 1).font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 0, 0)
        .Transparency = 0
        .Solid
    End With
  Sheets("W 1").Visible = False
  Sheets("W 2").Visible = False
  Sheets("W 3").Visible = False
  Sheets("W 4").Visible = False
  Sheets("W 5").Visible = False
  Sheets("MONKEY").Visible = False
  Sheets("Weather").Visible = False
  Sheets("SECRET!").Visible = False
  Sheets("UPDATE").Visible = False
  Sheets("The Great Diary Of Rock Springs").Visible = False
  Sheets("SECRET!").Visible = False
  Sheets("Setup").Visible = False
  Sheets("Usage").Visible = False
  Sheets("Labor").Visible = False
  Sheets("Info").Visible = False
  Sheets("JEDI GRAND MASTER BENJI").Visible = False
    Range("I8").Activate
    Application.ScreenUpdating = True
    ActiveSheet.Protect "GOKU"
    ActiveSheet.EnableSelection = xlUnlockedCells
    ActiveSheet.EnableSelection = xlLockedCells
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowSorting:=True




ElseIf Range("N14").Value = 6 Then
    Application.ScreenUpdating = False
    Rows("2:1001").Hidden = True
    ActiveSheet.DropDowns.Visible = False
    ActiveSheet.Pictures("err-1").Visible = False
    ActiveSheet.Pictures("err-2").Visible = False
    ActiveSheet.Pictures("err-3").Visible = False
    ActiveSheet.Pictures("err-4").Visible = False
    ActiveSheet.Pictures("err-5").Visible = False
    ActiveSheet.Pictures("DCHECK1").Visible = False
    ActiveSheet.Pictures("DCHECK2").Visible = False
    ActiveSheet.Pictures("DCHECK3").Visible = False
    ActiveSheet.Pictures("DCHECK4").Visible = False
    ActiveSheet.Pictures("DCHECK5").Visible = False
    ActiveSheet.Pictures("bad-1").Visible = False
    ActiveSheet.Pictures("bad-2").Visible = False
    ActiveSheet.Pictures("bad-3").Visible = False
    ActiveSheet.Pictures("bad-4").Visible = False
    ActiveSheet.Pictures("bad-5").Visible = False
    ActiveSheet.Shapes("start1a").Visible = False
    ActiveSheet.Shapes("start1b").Visible = False
    ActiveSheet.Shapes("start1c").Visible = False
    ActiveSheet.Shapes("start2a").Visible = False
    ActiveSheet.Shapes("start2b").Visible = False
    ActiveSheet.Shapes("start2c").Visible = False
    ActiveSheet.Shapes("start3a").Visible = False
    ActiveSheet.Shapes("start3b").Visible = False
    ActiveSheet.Shapes("start3c").Visible = False
    ActiveSheet.Shapes("start4a").Visible = False
    ActiveSheet.Shapes("start4b").Visible = False
    ActiveSheet.Shapes("start4c").Visible = False
    ActiveSheet.Shapes("start5a").Visible = False
    ActiveSheet.Shapes("start5b").Visible = False
    ActiveSheet.Shapes("start5c").Visible = False
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "Week 1"
    Rows("2:7").Hidden = False
    Rows("8:1000").Hidden = True
    ActiveSheet.Shapes.Range(Array("wbox1")).Select
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 1).font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    ActiveSheet.Shapes.Range(Array("wbox2")).Select
    Selection.ShapeRange.glow.Radius = 0
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 1).font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 0, 0)
        .Transparency = 0
        .Solid
    End With
    ActiveSheet.Shapes.Range(Array("wbox3")).Select
    Selection.ShapeRange.glow.Radius = 0
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 1).font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 0, 0)
        .Transparency = 0
        .Solid
    End With
    ActiveSheet.Shapes.Range(Array("wbox4")).Select
    Selection.ShapeRange.glow.Radius = 0
        With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 1).font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 0, 0)
        .Transparency = 0
        .Solid
    End With
    ActiveSheet.Shapes.Range(Array("wbox5")).Select
    Selection.ShapeRange.glow.Radius = 0
        With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 1).font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 0, 0)
        .Transparency = 0
        .Solid
    End With
  Sheets("W 1").Visible = False
  Sheets("W 2").Visible = False
  Sheets("W 3").Visible = False
  Sheets("W 4").Visible = False
  Sheets("W 5").Visible = False
  Sheets("MONKEY").Visible = False
  Sheets("Weather").Visible = False
  Sheets("SECRET!").Visible = False
  Sheets("UPDATE").Visible = False
  Sheets("The Great Diary Of Rock Springs").Visible = False
  Sheets("SECRET!").Visible = False
  Sheets("Setup").Visible = False
  Sheets("Usage").Visible = False
  Sheets("Labor").Visible = False
  Sheets("Info").Visible = False
  Sheets("JEDI GRAND MASTER BENJI").Visible = False
    Range("I8").Activate
    Application.ScreenUpdating = True
    ActiveSheet.Protect "GOKU"
    ActiveSheet.EnableSelection = xlUnlockedCells
    ActiveSheet.EnableSelection = xlLockedCells
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowSorting:=True
    With ActiveSheet
        .Rows("7:15").Hidden = False
        .Rows("22:22").Hidden = False
        .Rows("52:52").Hidden = False
        .Rows("88:88").Hidden = False
        .Rows("101:102").Hidden = False
        .Rows("114:114").Hidden = False
        .Rows("121:121").Hidden = False
        .Rows("134:134").Hidden = False
        .Rows("165:165").Hidden = False
        .Rows("173:173").Hidden = False
    End With
    ActiveWindow.ScrollRow = 2
    Range("G5:M5").Select
End If


End Sub

One additional note:
I have several copies of this code that get used throughout my worksheet, and each one has slight differences (shapes are different colors, different rows hidden, certain pictures visible) so I need to make sure I can still pretty easily update each version.
Any help would be greatly appreciated!

Andrew
 
Last edited:

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Sort by date Sort by votes
It looks like the code does the exact same thing for the two If conditions.
Code: 
If Range("N14").Value < 6 Then
    [COLOR=#008000]'Do stuff[/COLOR]
ElseIf Range("N14").Value = 6 Then
    [COLOR=#008000]'Do the same stuff[/COLOR]
End If


If that's the case, you could combine the two conditions and reduce your code by half.
Code: 
If Range("N14").Value [COLOR=#ff0000]<=[/COLOR] 6 Then
    [COLOR=#008000]'Do stuff[/COLOR]
End If
 
Upvote 0
There are a few minor differences at the bottom of each if condition.

the second set has this at the bottom:
Code: 
    With ActiveSheet        .Rows("7:15").Hidden = False
        .Rows("22:22").Hidden = False
        .Rows("52:52").Hidden = False
        .Rows("88:88").Hidden = False
        .Rows("101:102").Hidden = False
        .Rows("114:114").Hidden = False
        .Rows("121:121").Hidden = False
        .Rows("134:134").Hidden = False
        .Rows("165:165").Hidden = False
        .Rows("173:173").Hidden = False
    End With
    ActiveWindow.ScrollRow = 2
    Range("G5:M5").Select
 
Upvote 0
Then try something like this.

Code: 
If Range("N14").Value [COLOR="#FF0000"]<=[/COLOR] 6 Then[COLOR=#008000]   
   'Do the stuff common to both conditions[/COLOR]  
End If

If Range("N14").Value [COLOR="#FF0000"]=[/COLOR] 6 Then     [COLOR=#008000]
   'Do the the stuff unique to just this condition[/COLOR]
   With ActiveSheet        
        .Rows("7:15").Hidden = False
        .Rows("22:22").Hidden = False
        .Rows("52:52").Hidden = False
        .Rows("88:88").Hidden = False
        .Rows("101:102").Hidden = False
        .Rows("114:114").Hidden = False
        .Rows("121:121").Hidden = False
        .Rows("134:134").Hidden = False
        .Rows("165:165").Hidden = False
        .Rows("173:173").Hidden = False
    End With
    ActiveWindow.ScrollRow = 2
    Range("G5:M5").Select 
End If
 
Upvote 0
You must log in or register to reply here.

Similar threads

Deladier
  • Question
Deselect Freeform after Macro has ran (VBA)
Replies
3
Views
111
Domenic
D
K
  • Solved
how to 'deselect' textframes and shapes? (on a worksheet...)
Replies
7
Views
267
RoryA
RoryA
U
  • Solved
Unlocking shape/textbox in VBA
Replies
2
Views
537
UK_Kiwi
U
P
  • Question
Help With VBA Script
Replies
0
Views
198
Pirate_tat87
P
S
  • Question
VBA Help Please
2
Replies
16
Views
1K
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,216,484
Messages
6,130,936
Members
449,608
Latest member
jacobmudombe

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top