CODEWITHSUNDEEP
excelvbasimplify
Evan West
Evan West

Reputation: 53

How Can I Simplify This Bulky VBA If/Then Statement

So im a noob to vba, this is my 8th day ever working with any kind of coding so im sorry for the "brute force" method I am using in this code, I know its not efficient and there has to be a better way to do this. So thats exactly what im asking, how can i simplify this code? It runs fine and does what it needs to but its bulky an slow. 

'RefDate1=cell K36

Dim RefDate1 As Date

RefDate1 = Sheets("Monthly Status").Range("K36")
If RefDate1 = False Then
Sheets("Monthly Status").Range("K34").ClearContents
Sheets("Monthly Status").Range("K33").ClearContents
Sheets("Monthly Status").Range("K32").ClearContents
Sheets("Monthly Status").Range("K31").ClearContents
Sheets("Monthly Status").Range("K30").ClearContents
Sheets("Monthly Status").Range("K29").ClearContents
Sheets("Monthly Status").Range("K28").ClearContents
Sheets("Monthly Status").Range("K27").ClearContents
Sheets("Monthly Status").Range("K26").ClearContents
Sheets("Monthly Status").Range("K25").ClearContents
Sheets("Monthly Status").Range("K24").ClearContents
Else
Sheets("Monthly Status").Range("K34").Value = (RefDate1 - (7 * 6))
Sheets("Monthly Status").Range("K33").Value = (RefDate1 - (7 * 8))
Sheets("Monthly Status").Range("K32").Value = (RefDate1 - (7 * 9))
Sheets("Monthly Status").Range("K31").Value = (RefDate1 - (7 * 11))
Sheets("Monthly Status").Range("K30").Value = (RefDate1 - (7 * 12))
Sheets("Monthly Status").Range("K29").Value = (RefDate1 - (7 * 19))
Sheets("Monthly Status").Range("K28").Value = (RefDate1 - (7 * 20))
Sheets("Monthly Status").Range("K27").Value = (RefDate1 - (7 * 22))
Sheets("Monthly Status").Range("K26").Value = (RefDate1 - (7 * 23))
Sheets("Monthly Status").Range("K25").Value = (RefDate1 - (7 * 26))
Sheets("Monthly Status").Range("K24").Value = (RefDate1 - (7 * 26))
End If

Upvotes: 1

Views: 89

Answers (3)

VBasic2008
VBasic2008

Reputation: 54883

Simplify Bulky

Non-Contiguous Version

Sub Bulky()

    ' Sheet Name, Cells List, Date Cell, Weeks List, Days in Week
    Const cSheet As String = "Monthly Status"
    Const cCells As String = "K34,K33,K32,K31,K30,K29,K28,K27,K26,K25,K24"
    Const cDateCell As String = "K36"
    Const cWeeks As String = "6,8,9,11,12,19,20,22,23,26,26"
    Const cDays As Long = 7

    Dim vntC As Variant   ' Cells Array
    Dim vntW As Variant   ' Weeks Array
    Dim RefDate1 As Date  ' Date
    Dim i As Long         ' Arrays Row Counter

    With Sheets(cSheet)
        RefDate1 = .Range(cDateCell).Value
        If RefDate1 = False Then
            .Range(cCells).ClearContents
          Else
            vntC = Split(cCells, ",")
            vntW = Split(cWeeks, ",")
            For i = 0 To UBound(vntC)
                .Range(vntC(i)).Value = RefDate1 - (cDays * CLng(Trim(vntW(i))))
            Next
        End If
    End With

End Sub

Contiguous (K24:K34) Fast Version

Sub Bulky2()

    ' Sheet Name, Source Range, Date Cell, Weeks List, Days in Week
    Const cSheet As String = "Monthly Status"
    Const cCells As String = "K24:K34"
    Const cDateCell As String = "K36"
    Const cWeeks As String = "26,26,23,22,20,19,12,11,9,8,6"
    Const cDays As Long = 7

    Dim vntT As Variant   ' Target Array
    Dim vntW As Variant   ' Weeks Array
    Dim RefDate1 As Date  ' Date
    Dim i As Long         ' Arrays Row Counter

    With Sheets(cSheet)
        RefDate1 = .Range(cDateCell).Value
        If RefDate1 = False Then
            .Range(cCells).ClearContents
          Else
            vntW = Split(cWeeks, ",")
            ReDim vntT(1 To UBound(vntW) + 1, 1 To 1)
            For i = 1 To UBound(vntT)
                vntT(i, 1) = RefDate1 - (cDays * CLng(Trim(vntW(i - 1))))
            Next
            .Range(cCells) = vntT
        End If
    End With

End Sub

Upvotes: -1

Harassed Dad
Harassed Dad

Reputation: 4704

Alternatively 

    Dim RefDate1 As Date
    With  Sheets("Monthly Status")  'use with to save retyping
        RefDate1 =.Range("K36")
        If RefDate1 = False Then
            .Range("K24:K34").ClearContents

        Else
          Dim v
          v = Array(26, 26, 23, 22, 20, 20, 19, 12, 11, 9, 8, 6)   'set up an array

          Dim x  'and a counter
          With Range("K24")  'start at the top
               For x = 0 To 11  'going down 11 cells
              .Offset(x, 0).Value = (RefDate1 - (7 * v(x)))  'an offset of x rows,zero columns
              Next x
          End With
    End If
    end with

Upvotes: 0

urdearboy
urdearboy

Reputation: 14590

A worksheet variable will go along way here.... once declared, swap every instance of Sheets("Monthly Status") with the variable name (ws)

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Monthly Status")    

If Not RefDate1 Then
    ws.Range("K24:K34").ClearContents
Else
    ws.Range("K24:K25") = RefDate1 - (7 * 26)
    ws.Range("K26") = RefDate1 - (7 * 23)
    'and so on......
End If

Upvotes: 3

Related Questions