Formula to VBA

[chester27]

I am trying to reduce the processing time of a spreadsheet that contains the following formula. The constants need to remain constant but the rest will need to reflect the position in the worksheet e.g. as it would if the formula were copied across columns.

=IF(AND($K10>=X$4,$K10<Y$4),$K$6,IF(X$3="XSD","Xmas",IF(AND($L10>=X$4,$
L10<Y$4),$L$6,IF(AND($M10>=X$4,$M10<Y$4),$M$6,IF(AND($N10>=X$4,$N10<Y$4
),$N$6,IF(AND($O10>=X$4,$O10<Y$4),$O$6,IF(AND($P10>=X$4,$P10<Y$4),$P$6,
IF(AND($S10>=X$4,$S10<Y$4),$S$6,IF(AND($R10>=X$4,$R10<Y$4),$R$6,IF(AND(
$Q10>=X$4,$Q10<Y$4),$Q$6,IF(OR(Y10=$K$6,Y10=$L$6,Y10=$M$6,Y10=$N$6,Y10=
$O$6,Y10=$P$6),SUM(MAX(Y10:AE10)+1),IF(AND(Y10>0,Y10<10),SUM(MAX(Y10:AE
10)+1),IF(Y10="Aircon","",IF(Y10="","",IF(AND(Y10="Xmas",Z10="Xmas",OR(
AA10="",AA10="Aircon")),"",SUM(MAX(Y10:AE10)+1))))))))))))))))

Any assistance converting this into a VBA function would be much appreciated.

 

[zelgar]

I think the following macro will do everything you want:

Sub chester27()
Dim c As Integer, r As Integer, c_start As Integer, r_start As Integer, rng As Range, s, i As Integer, j As Integer, x

' c and r are varables that can be modified if you were going to copy & paste the formula you'd have a loop to increment c and/or r
c = 0
r = 0

' determining max value in Range Y10:AE10 if needed later
Set rng = Range(Cells(10 + c, 25 + r), Cells(10 + c, 31 + r))
s = (Cells(10 + c, 25 + r))
For Each x In rng
    If x.Value > s Then s = x
Next x

'   c_start and r_start is the location where the formula is orginally at in the spreadsheet (e.g., A1, c_start = 1 (column) and r_start is 1 (row))
c_start = 1
r_start = 1


If Cells(10 + r, 11) >= Cells(4, 24 + c) And Cells(10 + r, 11) < Cells(4, 25 + c) Then
    Cells(r_start + r, c_start + c) = Cells(6, 11)
    ElseIf Cells(3, 24 + c) = "XSD" Then
        Cells(r_start + r, c_start + c) = "Xmas"
    Else
    For i = 12 To 16    ' For If statments of $L10 to $P10
        If Cells(i + r, 12) >= Cells(4, 24 + c) And Cells(i + r, 12) < Cells(4, 25 + c) Then
            Cells(r_start + r, c_start + c) = Cells(6, i)
            i = 100  ' this is to stop the For loop
        End If
    Next i
    If i <> 100 Then
        For j = 19 To 17 Step -1    ' For IF statements $S10 to $Q10
            If Cells(j + r, 13) >= Cells(4, 24 + c) And Cells(j + r, 13) < Cells(4, 25 + c) Then
                Cells(r_start + r, c_start + c) = Cells(6, j)
                j = 0  ' this is to stop the For loop
            End If
        Next j
        If j > 0 Then
            Select Case Cells(10 + c, 25 + r)
                Case Cells(6, 11), Cells(6, 12), Cells(6, 13), Cells(6, 14), Cells(6, 15), Cells(6, 16)
                    Cells(r_start + r, c_start + c) = s + 1
                Case Is > 0, Is < 10
                    Cells(r_start + r, c_start + c) = s + 1
                Case "Aircon", ""
                    Cells(r_start + r, c_start + c) = ""
                Case "Xmas"
                    If Cells(10 + c, 26 + r) = "Xmas" And (Cells(10 + c, 27 + r) = "" Or Cells(10 + c, 27 + r) = "Aircon") Then _
                        Cells(r_start + r, c_start + c) = ""
                Case Else
                    Cells(r_start + r, c_start + c) = s + 1
            End Select
        End If
    End If
End If


End Sub

 

[SkipVought]

Hi,

I'd guess that columns K thru Q are dates and row 4 starting in column X are first of the week/month/??? dates.
Can't determine how many columns these dates are in.
Then you have a rolling Sum of the Max over 7 columns in the row.
Then you have some constants in row 6.
Then you've got some really wierd stuff in row 10 starting in column Y:

If Y10 is 1 to 9 Then the rolling Sum of the Max
Else If Y10 is Aircon Then zero length string
Else If Y10 and Z10 are Xmas OR (AA10 is zero length string OR AA10 is Aircon) Then zero length string
Else the rolling Sum of the Max​

What's wierd is you've got numbers and strings Where you're doing the Sum Of the Max ????

Nonetheless, if you were to name the ranges K to Q, the period range in row 4, each constant in row 6.
I'm guessing that row 9 has headings and your data begins in row 10. The rows above are constants and period range.
Having named ranges will assist in generating understandable VBA code. You might also consider making your table a Structured Table via Insert> Tables > Table.
It would also greatly help if you could UPLOAD you workbook. It it contains sensitive data, truncate the table to a handful of representative rows and dummy up the sensitive cells.



Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[zelgar]

I noticed that I had a slight error in the following lines of code:
If Cells(i + r, 1210 + r, i) >= Cells(4, 24 + c) And Cells(i + r, 1210 + r, i) < Cells(4, 25 + c) Then

If Cells(j + r, 1310 + r, j) >= Cells(4, 24 + c) And Cells(j + r, 1310 + r, j) < Cells(4, 25 + c) Then

The revised macro would look like the following:

Sub chester27()
Dim c As Integer, r As Integer, c_start As Integer, r_start As Integer, rng As Range, s, i As Integer, j As Integer, x

' c and r are varables that can be modified if you were going to copy & paste the formula you'd have a loop to increment c and/or r
c = 0
r = 0

' determining max value in Range Y10:AE10 if needed later
Set rng = Range(Cells(10 + c, 25 + r), Cells(10 + c, 31 + r))
s = (Cells(10 + c, 25 + r))
For Each x In rng
    If x.Value > s Then s = x
Next x

'   c_start and r_start is the location where the formula is orginally at in the spreadsheet (e.g., A1, c_start = 1 (column) and r_start is 1 (row))
c_start = 1
r_start = 1


If Cells(10 + r, 11) >= Cells(4, 24 + c) And Cells(10 + r, 11) < Cells(4, 25 + c) Then
    Cells(r_start + r, c_start + c) = Cells(6, 11)
    ElseIf Cells(3, 24 + c) = "XSD" Then
        Cells(r_start + r, c_start + c) = "Xmas"
    Else
    For i = 12 To 16    ' For If statments of $L10 to $P10
        If Cells(10 + r, i) >= Cells(4, 24 + c) And Cells(10 + r, i) < Cells(4, 25 + c) Then
            Cells(r_start + r, c_start + c) = Cells(6, i)
            i = 100  ' this is to stop the For loop
        End If
    Next i
    If i <> 100 Then
        For j = 19 To 17 Step -1    ' For IF statements $S10 to $Q10
            If Cells(10 + r, j) >= Cells(4, 24 + c) And Cells(10 + r, j) < Cells(4, 25 + c) Then
                Cells(r_start + r, c_start + c) = Cells(6, j)
                j = 0  ' this is to stop the For loop
            End If
        Next j
        If j > 0 Then
            Select Case Cells(10 + c, 25 + r)
                Case Cells(6, 11), Cells(6, 12), Cells(6, 13), Cells(6, 14), Cells(6, 15), Cells(6, 16)
                    Cells(r_start + r, c_start + c) = s + 1
                Case Is > 0, Is < 10
                    Cells(r_start + r, c_start + c) = s + 1
                Case "Aircon", ""
                    Cells(r_start + r, c_start + c) = ""
                Case "Xmas"
                    If Cells(10 + c, 26 + r) = "Xmas" And (Cells(10 + c, 27 + r) = "" Or Cells(10 + c, 27 + r) = "Aircon") Then _
                        Cells(r_start + r, c_start + c) = ""
                Case Else
                    Cells(r_start + r, c_start + c) = s + 1
            End Select
        End If
    End If
End If
End Sub