CODEWITHSUNDEEP
excelvba
Cameron Cotton
Cameron Cotton

Reputation: 45

How to I consolidate repetitive VBA code?

I am new at writing VBA and have been looking through stack overflow to accomplish what I've needed so far. The code I have written works just fine for me, but other people seem to get compiling issues. I have shrunk the code down (there are 1204 procedures in the actual string which, needless to say, is a lot).

I am looking for help with consolidating what I have written. Will you please take a look and recommend a good way to shrink this code in order to alleviate the redundancy?

Thank you for the help!

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim c&, i&, k, v, col
  
  DoEvents
  ReDim v(1 To 1224, 1 To 2)
  
  For i = 1 To 102
    v(i, 1) = "O" & 6 + i
    Select Case i
        Case Is <= 70
            v(i, 2) = "=A"
        Case Is <= 100
            v(i, 2) = "=B"
        Case Else
            v(i, 2) = "=D"
    End Select
  Next i

  For i = 103 To 204
    v(i, 1) = "T" & 6 + i
    Select Case i
        Case Is <= 172
            v(i, 2) = "=A"
        Case Is <= 202
            v(i, 2) = "=B"
        Case Else
            v(i, 2) = "=D"
    End Select
  Next i

  For i = 205 To 306
    v(i, 1) = "Y" & 6 + i
    Select Case i
        Case Is <= 274
            v(i, 2) = "=A"
        Case Is <= 304
            v(i, 2) = "=B"
        Case Else
            v(i, 2) = "=D"
    End Select
  Next i
  
  With Application
    .Calculation = xlCalculationManual
    .EnableEvents = False
    For i = 1 To UBound(v)
      With Range(v(i, 1))
        If Not Intersect(Target, .Cells) Is Nothing Then
            If Len(.Value2) = 0 Then
            .Formula = v(i, 2)
          End If
        End If
      End With
    Next
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
  End With
  
  
End Sub

Upvotes: 0

Views: 77

Answers (2)

Toddleson
Toddleson

Reputation: 4457

You can do it easily with a For loop.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim c&, i&, k, v, col$, fml$
  
  DoEvents
  ReDim v(1 To 306, 1 To 2)
  
  For i = 1 To 306
    'Decide on the Formula
    Select Case i
        Case Is <= 70, 103 To 172, 205 To 274
            fml = "=A"
        Case 71 To 100, 173 To 202, 275 To 304
            fml = "=B"
        Case 101 To 102, 203 To 204, Is >= 305
            fml = "=D"
    End Select
    
    'Decide on the Column
    Select Case i
        Case Is <= 102
            col = "O"
        Case Is <= 204
            col = "T"
        Case Is <= 306
            col = "Y"
    End Select
    v(i, 1) = col & 6 + i 'This may need correction
    v(i, 2) = fml
  Next i
  
  With Application
    .Calculation = xlCalculationManual
    .EnableEvents = False
    For i = 1 To UBound(v)
      With Range(v(i, 1))
        If Not Intersect(Target, .Cells) Is Nothing Then
            If Len(.Value2) = 0 Then
            .Formula = v(i, 2)
          End If
        End If
      End With
    Next
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
  End With
  
End Sub

The line v(i, 1) = col & 6 + i will result in the range looking like "O7:O108,T109:T210,Y211:Y312". But if you wanted "O7:O108,T7:T108,Y7:Y108" then you will need to edit that line into v(i, 1) = col & 6 + ((i - 1) Mod 102) + 1

I didn't look at the other half of the code at first, but I now notice the With Range() inside the For loop. That's already inside the With Application block! It's not a good idea to double up seperate With blocks like that.

Suggested Edit for the second half:

    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    For i = 1 To UBound(v)
      With Range(v(i, 1))
        If Not Intersect(Target, .Cells) Is Nothing Then
            If Len(.Value2) = 0 Then
            .Formula = v(i, 2)
          End If
        End If
      End With
    Next
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic

Upvotes: 1

Tim Williams
Tim Williams

Reputation: 166156

Something like this should work

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim i As Long, c As Range, f
    
    On Error GoTo haveError
    Application.EnableEvents = False
    
    For Each c In Target.Cells     'loop over Target cells
        For i = 15 To 70 Step 5    'check each column from O to BR
            If Not Application.Intersect(c, Me.Range(Me.Cells(7, i), Me.Cells(109, i))) Is Nothing Then
                'Target cell is in the column range...
                If Len(c.Value) = 0 and c.Row <> 35 Then
                    Select Case c.Row
                        Case 7 To 77: f = "=A"
                        Case 78 To 107: f = "=B"
                        Case Else: f = "=D"
                    End Select
                    c.Formula2 = f 'this formula seems incomplete though?
                End If
            End If
            Exit For 'stop checking for this cell 
        Next i
    Next c
    
'ensure events not left off in the event of an error
haveError:
    Application.EnableEvents = True
  
End Sub

Upvotes: 2

Related Questions