# Standardize and reduce repeating same procedures in my coding Excel VBA [closed]

I am aware that my VBA code can be improved.I would like to standardize and reduce repeating same procedures. Can I have some guide lines for this? Where to start? I would be glad to have some examples from you! I would like to learn to write code more efficiently. Also does this will improve efficiency too?

' Color_code
'

Dim white, red, green, orange, peach, yellow, pink, blue, maroon, violet,
black As Long

white = RGB(255, 255, 255) 'White
red = RGB(255, 0, 0) 'Red
green = RGB(215, 228, 188) 'Green
orange = RGB(228, 109, 10) 'Orange
peach = RGB(242, 174, 92) 'Peach
yellow = RGB(255, 255, 113) 'Yellow
pink = RGB(255, 182, 193) 'Pink
blue = RGB(147, 205, 221) 'Blue
maroon = RGB(149, 55, 53) 'Maroon
violet = RGB(204, 192, 218) 'Violet
black = RGB(0, 0, 0) 'Black

ws_kanban.Select
Set shelf_card = ActiveSheet.Range("A1:E10")
Set trav_card = ActiveSheet.Range("A12:G21")
Set int_supp = ActiveSheet.Range("C17:E17")
Set int_supp_loc = ActiveSheet.Range("C20:E20")
Set section = ws_kanban_data.Range("G2")
Set section2 = ActiveSheet.Range("G2:H2")
Set warning = ActiveSheet.Range("G6")
Set warning2 = ActiveSheet.Range("G7")
Set issue_type = ActiveSheet.Range("F1:F10")
Set issue_type_trav = ActiveSheet.Range("H12:H21")
Set types = ws_kanban_data.Range("F2")
section2.Select

If section = "MECH" Then
shelf_card.Interior.Color = green
trav_card.Interior.Color = green
ElseIf section = "LAB" Then
shelf_card.Interior.Color = orange
trav_card.Interior.Color = orange
ElseIf section = "HOCC" Then
shelf_card.Interior.Color = peach
trav_card.Interior.Color = peach
ElseIf section = "SASW" Then
shelf_card.Interior.Color = yellow
trav_card.Interior.Color = yellow
ElseIf section = "SAMO" Then
shelf_card.Interior.Color = pink
trav_card.Interior.Color = pink
ElseIf section = "RRC" Then
shelf_card.Interior.Color = blue
trav_card.Interior.Color = blue
ElseIf section = "CUST" Then
shelf_card.Interior.Color = maroon
trav_card.Interior.Color = maroon
ElseIf section = "PE" Then
shelf_card.Interior.Color = red
trav_card.Interior.Color = red
ElseIf section = "PACK" Then
shelf_card.Interior.Color = violet
trav_card.Interior.Color = violet
ElseIf section = "LC" Then
shelf_card.Interior.Color = white
trav_card.Interior.Color = white
Else
section2.Font.Color = white
warning.Value = "Check Section!!"
For i = 1 To 2
shelf_card.Interior.Color = red
trav_card.Interior.Color = red
warning.Interior.Color = red
warning.Font.Color = white
Application.Wait (Now + TimeValue("0:00:01"))
shelf_card.Interior.Color = white
trav_card.Interior.Color = white
warning.Interior.Color = white
warning.Font.Color = red
Application.Wait (Now + TimeValue("0:00:01"))
Next i
warning.Font.Color = white
warning.Interior.Color = red
End If

If types = "M" Then
issue_type.Value = "Manual Issue "
issue_type_trav.Value = "Manual Issue "
issue_type.Interior.Color = black
issue_type_trav.Interior.Color = black
issue_type.Font.Color = white
issue_type_trav.Font.Color = white
ElseIf types = "B" Then
issue_type.Interior.ColorIndex = 0
issue_type_trav.Interior.ColorIndex = 0
issue_type.Font.Color = white
issue_type_trav.Interior.ColorIndex = 0
Else
issue_type.Interior.ColorIndex = 0
issue_type_trav.Interior.ColorIndex = 0
issue_type.Font.Color = white
issue_type_trav.Interior.ColorIndex = 0
warning2.Value = "Check Type!!"
For i = 1 To 2
shelf_card.Interior.Color = red
trav_card.Interior.Color = red
warning2.Interior.Color = red
warning2.Font.Color = white
Application.Wait (Now + TimeValue("0:00:01"))
shelf_card.Interior.Color = white
trav_card.Interior.Color = white
warning2.Interior.Color = white
warning2.Font.Color = red
Application.Wait (Now + TimeValue("0:00:01"))
Next i
warning2.Font.Color = white
warning2.Interior.Color = red
End If

• This question lacks any indication of what the code is intended to achieve. To help reviewers give you better answers, please add sufficient context to your question, including a title that summarises the purpose of the code. We want to know why much more than how. The more you tell us about what your code is for, the easier it will be for reviewers to help you. The title needs an edit to simply state the task. Mar 18 '19 at 9:44
• It also doesn't appear to be a complete, functional subroutine of any sort - just a snippet or two from random places in code. Mar 18 '19 at 11:42

If you're going to do any developing in VBA then you need to check out Rubberduck . Open disclosure, I'm a contributor. I've used it for long enough now that the IDE doesn't feel complete without it. Rubberduck will help you write better code and teach you along the way with code inspections and other goodies.

Dim white, red, ... , black as Long is only having the last variable black actually declared as Long. The rest are implicitly as Variant. Something that Rubberduck will spot for you as part of its Code Inspections. If you declare several variables I advocate doing them each on their own line. You can avoid doing this by using enumeration values from VBA.ColorConstants.vbWhite, I mention this since this is available through the VBA. However, since you are using Excel you have access to XlRgbColor enumeration and you can access as an unqualified rgbWhite , enumeration qualified XlRgbColor.rgbWhite, or fully qualified Excel.XlRgbColor.rgbWhite member. You'll have to map out what's closest to the colors you want. If that doesn't suffice you can create your own enumeration as I included in the example.

Private Enum MyEnumeration
peach = 6074098  'rgb(242,174,92)
'...
violet = 14336204   'RGB(204, 192, 218)
End Enum


I don't know if you have turned on Option Explicit as it wasn't included. In the VBA IDE menu at the top Tools>Options>Editor tab>Code Settings group>Require Variable Declaration should be turned on. This mandates you declare all your variables, Dim foo as Bar, before you can use them. It'll save you hours of hair pulling and needless typographical errors since implicit variables won't be created for you.

To take those variable declarations a step further convert them to named ranges. This will eliminate static cell references that break when, not if, a cell is moved. You can enter a name by navigating through the Ribbon under the Formulas tab>Defined Names group>Name Manager or using either of the Hotkeys Ctrl+F3, Alt, M, N, or Alt, I, N, D. This will display the Name Manager dialog and from there you can add the named range. As a best practice don't forget when adding a named range in the New Name dialog to change the Scope dropdown to the specific sheet the range is on. Scoping a named range like this lets you add a getter property for the worksheet thy are one. These properties will look like

Public Property Get ShelfCard() As Range
Set ShelfCard = Me.Range("ShelfCard")
End Property


So you can go from what you currently have

Set shelf_card = ActiveSheet.Range("A1:E10")
...
shelf_card.Interior.Color = green
...


to

KanBan.ShelfCard.Interior.Color = MyEnumeration.green


Avoid Worksheet.Select and Activesheet.FooBar = ... or the implicit Range("A1").FooBar = .... You rarely have to select worksheet to achieve something programatically.

Next. Take all the If ... ElseIf ... End If and create a specific sub procedure for them. Something like Private Sub UpdateBasedOnSection(ByVal sectionValue As String) that encapsulates all the logic. This way when you call the sub it'll look something like UpdateBasedOnSection KanBanData.Section2. Hidden in this logic was a redundant issue_type_trav.Interior.ColorIndex = 0. When setting properties, group them so all the KanBan.IssueType properties are set, then move onto the next. Mixing them together makes it easy to miss these redundancies. There's also duplicated logic in the For ... Next block that should be refactored into its own sub.

Once you've done this you'll have cleaned up the code. Below is what I ended up achieving. The entirety of your module ended up being contained in CodeReview. More can be done but this should is a good start for now.

'Module1 standard module
Option Explicit

Public Enum MyEnumeration
green = 12379351  'RGB(215,228,188)
orange = 683492   'RGB(228,109,10)
peach = 6074098  'rgb(242,174,92)
yellow = 7471103 'RGB(255, 255, 113)
pink = 12695295 'RGB(255, 182, 193)
blue = 14536083  'RGB(147, 205, 221)
maroon = 3487637 'RGB(149, 55, 53)
violet = 14336204   'RGB(204, 192, 218)
End Enum

Public Sub CodeReview()
UpdateBasedOnSection KanBan.Section2
UpdateBasedOnTypes KanBanData.Types
End Sub

Private Sub UpdateBasedOnSection(ByVal sectionValue As String)
Dim updateColor As Long
If ShouldSectionColorBeUpdated(sectionValue, updateColor) Then
KanBan.ShelfCard.Interior.Color = updateColor
KanBan.TravelCard.Interior.Color = updateColor
Else
KanBan.Section2.Font.Color = XlRgbColor.rgbWhite
KanBan.Warning.Value2 = "Check Section!!"
WarningFlash KanBan.Warning
End If
End Sub

Private Function ShouldSectionColorBeUpdated(ByVal sectionValue As String, ByRef outSectionColor As Long) As Boolean
ShouldSectionColorBeUpdated = True
Select Case sectionValue
Case "MECH"
outSectionColor = MyEnumeration.green
Case "LAB"
outSectionColor = MyEnumeration.orange
Case "HOCC"
outSectionColor = MyEnumeration.peach
Case "SASW"
outSectionColor = MyEnumeration.yellow
Case "SAMO"
outSectionColor = MyEnumeration.pink
Case "RRC"
outSectionColor = MyEnumeration.blue
Case "CUST"
outSectionColor = MyEnumeration.maroon
Case "PE"
outSectionColor = XlRgbColor.rgbRed
Case "PACK"
outSectionColor = MyEnumeration.violet
Case "LC"
outSectionColor = XlRgbColor.rgbWhite
Case Else
outSectionColor = -1
ShouldSectionColorBeUpdated = False
End Select
End Function

Private Sub UpdateBasedOnTypes(ByVal Types As String)
If Types = "M" Then
With KanBan.IssueType
.Value2 = "Manual Issue "
.IssueType.Interior.Color = XlRgbColor.rgbBlack
.IssueType.Font.Color = XlRgbColor.rgbWhite
End With

With KanBan.IssueTypeTravel
.Value2 = "Manual Issue "
.Interior.Color = XlRgbColor.rgbBlack
.Font.Color = XlRgbColor.rgbWhite
End With
Else
KanBan.IssueType.Interior.ColorIndex = 0
KanBan.IssueType.Font.Color = XlRgbColor.rgbWhite
KanBan.IssueTypeTravel.Interior.ColorIndex = 0

If Types <> "B" Then
KanBan.Warning2.Value2 = "Check Type!!"
WarningFlash KanBan.Warning2
End If
End If
End Sub

Private Sub WarningFlash(ByVal warningCell As Range)
Const OneSecond As Double = #12:00:01 AM#
Dim i As Long
For i = 1 To 2
KanBan.ShelfCard.Interior.Color = XlRgbColor.rgbRed
KanBan.TravelCard.Interior.Color = XlRgbColor.rgbRed
warningCell.Interior.Color = XlRgbColor.rgbRed
warningCell.Font.Color = XlRgbColor.rgbWhite
Application.Wait Now + OneSecond
KanBan.ShelfCard.Interior.Color = XlRgbColor.rgbWhite
KanBan.TravelCard.Interior.Color = XlRgbColor.rgbWhite
warningCell.Interior.Color = XlRgbColor.rgbWhite
warningCell.Font.Color = XlRgbColor.rgbRed
Application.Wait Now + OneSecond
Next i
warningCell.Font.Color = XlRgbColor.rgbWhite
warningCell.Interior.Color = XlRgbColor.rgbRed
End Sub

'KanBan worksheet
Option Explicit

Public Property Get ShelfCard() As Range
Set ShelfCard = Me.Range("ShelfCard")
End Property

Public Property Get TravelCard() As Range
Set TravelCard = Me.Range("TravelCard")
End Property

Public Property Get InternalSupport() As Range
Set InternalSupport = Me.Range("InternalSupport")
End Property

Public Property Get InternalSupportLocation() As Range
Set InternalSupportLocation = Me.Range("InternalSupportLocation")
End Property

Public Property Get Section2() As Range 'Use a better more descriptive name
Set Section2 = Me.Range("Section2")
End Property

Public Property Get Warning() As Range 'Advocate changing to what the warning actually is about
Set Warning = Me.Range("Warning")
End Property

Public Property Get Warning2() As Range
Set Warning2 = Me.Range("Warning2")
End Property

Public Property Get IssueType() As Range
Set IssueType = Me.Range("IssueType")
End Property

Public Property Get IssueTypeTravel() As Range
Set IssueTypeTravel = Me.Range("IssueTypeTravel")
End Property

'KanBanData worksheet
Option Explicit

Public Property Get Types() As String
Types = Me.Range("Types").Value2
End Property

• Thanks for your help. Its a great start for me! I will go trough your reviews and fix while learning! Mar 18 '19 at 5:24