-1
\$\begingroup\$

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
\$\endgroup\$
2
  • 1
    \$\begingroup\$ 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. \$\endgroup\$ Mar 18 '19 at 9:44
  • \$\begingroup\$ It also doesn't appear to be a complete, functional subroutine of any sort - just a snippet or two from random places in code. \$\endgroup\$
    – FreeMan
    Mar 18 '19 at 11:42
4
\$\begingroup\$

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
\$\endgroup\$
1
  • \$\begingroup\$ Thanks for your help. Its a great start for me! I will go trough your reviews and fix while learning! \$\endgroup\$
    – Matthew
    Mar 18 '19 at 5:24

Not the answer you're looking for? Browse other questions tagged or ask your own question.