Block If
 

I'm trying to create a really long =if command in Excel VBA editor but I keep
getting multiple errors, the latest is a "End if with no block If" error.
But I know I'm setting up the character values incorrectly also! Please
Help!!!

Sub Usage()

Dim Usage As Double
Dim J As Double
Dim K As Double
Dim L As Double
Dim M As Double
Dim N As Double
Dim O As Double
Dim P As Double
Dim Q As Double
Dim R As Double
Dim S As Double
Dim T As Double
Dim U As Double
Dim W As Double

K = Cell.K2
L = Cell.L2
M = Cell.M2
N = Cell.N2
O = Cell.O2
P = Cell.P2
Q = Cell.Q2
R = Cell.R2
S = Cell.S2
T = Cell.T2
U = Cell.U2
W = Cell.W2


Usage = (K + M + O + Q + S + U) / 6

If Usage 20 Then Cell.AA2 = (W / 15) Else:

If (J / K) (L / M) And (J / K) (N / O) And (J / K) (P / Q) And (J / K)
(R / S) And (J / K) (T / U) Then Cell.AA2 = (J / K) Else:
If (L / M) (J / K) And (L / M) (N / O) And (L / M) (P / Q) And (L / M)
(R / S) And (L / M) (T / U) Then Cell.AA2 = (L / M) Else:
If (N / O) (L / M) And (N / O) (J / K) And (N / O) (P / Q) And (N / O)
(R / S) And (N / O) (T / U) Then Cell.AA2 = (N / O) Else:
If (P / Q) (L / M) And (P / Q) (N / O) And (P / Q) (J / K) And (P / Q)
(R / S) And (P / Q) (T / U) Then Cell.AA2 = (J / K) Else:
If (R / S) (L / M) And (R / S) (N / O) And (R / S) (P / Q) And (R / S)
(J / K) And (R / S) (T / U) Then Cell.AA2 = (R / S) Else:
If (T / U) (L / M) And (T / U) (N / O) And (T / U) (P / Q) And (T / U)
(R / S) And (T / U) (J / K) Then Cell.AA2 = (T / U)
End If
End If
End If
End If
End If
End If
End If


Selection.AutoFill Destination:=Range("AA2:AA3943"), Type:=xlFillDefault
Range("AA2:AA3943").Select

End Sub

Block If
 

It looks like you're using the wrong syntax for cells.
If "K = Cell.K2" is supposed to assign the contents of K2 to the variable
K, you need to use the following syntax:

K = Range("K2").value
L = Range("L2").value
....

so also
If Usage 20 Then Cell.AA2 = (W / 15) Else:

becomes
If Usage 20 Then Range("AA2").value = (W / 15) Else:

You can use Cells(row,column) in place of Range(cell address)

Darren

On Fri, 16 Dec 2005 08:53:02 -0000, DA@PD""
wrote:

I'm trying to create a really long =if command in Excel VBA editor but I
keep
getting multiple errors, the latest is a "End if with no block If" error.
But I know I'm setting up the character values incorrectly also! Please
Help!!!

Sub Usage()

Dim Usage As Double
Dim J As Double
Dim K As Double
Dim L As Double
Dim M As Double
Dim N As Double
Dim O As Double
Dim P As Double
Dim Q As Double
Dim R As Double
Dim S As Double
Dim T As Double
Dim U As Double
Dim W As Double

K = Cell.K2
L = Cell.L2
M = Cell.M2
N = Cell.N2
O = Cell.O2
P = Cell.P2
Q = Cell.Q2
R = Cell.R2
S = Cell.S2
T = Cell.T2
U = Cell.U2
W = Cell.W2


Usage = (K + M + O + Q + S + U) / 6
If Usage 20 Then Cell.AA2 = (W / 15) Else:

If (J / K) (L / M) And (J / K) (N / O) And (J / K) (P / Q) And (J
/ K)
(R / S) And (J / K) (T / U) Then Cell.AA2 = (J / K) Else:
If (L / M) (J / K) And (L / M) (N / O) And (L / M) (P / Q) And (L
/ M)
(R / S) And (L / M) (T / U) Then Cell.AA2 = (L / M) Else:
If (N / O) (L / M) And (N / O) (J / K) And (N / O) (P / Q) And (N
/ O)
(R / S) And (N / O) (T / U) Then Cell.AA2 = (N / O) Else:
If (P / Q) (L / M) And (P / Q) (N / O) And (P / Q) (J / K) And (P
/ Q)
(R / S) And (P / Q) (T / U) Then Cell.AA2 = (J / K) Else:
If (R / S) (L / M) And (R / S) (N / O) And (R / S) (P / Q) And (R
/ S)
(J / K) And (R / S) (T / U) Then Cell.AA2 = (R / S) Else:
If (T / U) (L / M) And (T / U) (N / O) And (T / U) (P / Q) And (T
/ U)
(R / S) And (T / U) (J / K) Then Cell.AA2 = (T / U)
End If
End If
End If
End If
End If
End If
End If


Selection.AutoFill Destination:=Range("AA2:AA3943"), Type:=xlFillDefault
Range("AA2:AA3943").Select

End Sub




--
------------------
Darren

Block If
 

This at least compiles and is somewhat more readable

Usage = (K + M + O + Q + S + U) / 6

If Usage 20 Then
Cell.AA2 = (W / 15)
ElseIf (J / K) (L / M) And (J / K) (N / O) And _
(J / K) (P / Q) And (J / K) (R / S) And _
(J / K) (T / U) Then
Cell.AA2 = (J / K)
ElseIf (L / M) (J / K) And (L / M) (N / O) And _
(L / M) (P / Q) And (L / M) (R / S) And _
(L / M) (T / U) Then Cell.AA2 = (L / M)
ElseIf (N / O) (L / M) And (N / O) (J / K) And _
(N / O) (P / Q) And (N / O) (R / S) And _
(N / O) (T / U) Then
Cell.AA2 = (N / O)
ElseIf (P / Q) (L / M) And (P / Q) (N / O) And _
(P / Q) (J / K) And (P / Q) (R / S) And _
(P / Q) (T / U) Then
Cell.AA2 = (J / K)
ElseIf (R / S) (L / M) And (R / S) (N / O) And _
(R / S) (P / Q) And (R / S) (J / K) And _
(R / S) (T / U) Then
Cell.AA2 = (R / S)
ElseIf (T / U) (L / M) And (T / U) (N / O) And _
(T / U) (P / Q) And (T / U) (R / S) And _
(T / U) (J / K) Then
Cell.AA2 = (T / U)
End If


--

HTH

RP
(remove nothere from the email address if mailing direct)


"DA@PD" wrote in message
...
I'm trying to create a really long =if command in Excel VBA editor but I
keep
getting multiple errors, the latest is a "End if with no block If" error.
But I know I'm setting up the character values incorrectly also! Please
Help!!!

Sub Usage()

Dim Usage As Double
Dim J As Double
Dim K As Double
Dim L As Double
Dim M As Double
Dim N As Double
Dim O As Double
Dim P As Double
Dim Q As Double
Dim R As Double
Dim S As Double
Dim T As Double
Dim U As Double
Dim W As Double

K = Cell.K2
L = Cell.L2
M = Cell.M2
N = Cell.N2
O = Cell.O2
P = Cell.P2
Q = Cell.Q2
R = Cell.R2
S = Cell.S2
T = Cell.T2
U = Cell.U2
W = Cell.W2


Usage = (K + M + O + Q + S + U) / 6

If Usage 20 Then Cell.AA2 = (W / 15) Else:

If (J / K) (L / M) And (J / K) (N / O) And (J / K) (P / Q) And (J /
K)
(R / S) And (J / K) (T / U) Then Cell.AA2 = (J / K) Else:
If (L / M) (J / K) And (L / M) (N / O) And (L / M) (P / Q) And (L /
M)
(R / S) And (L / M) (T / U) Then Cell.AA2 = (L / M) Else:
If (N / O) (L / M) And (N / O) (J / K) And (N / O) (P / Q) And (N /
O)
(R / S) And (N / O) (T / U) Then Cell.AA2 = (N / O) Else:
If (P / Q) (L / M) And (P / Q) (N / O) And (P / Q) (J / K) And (P /
Q)
(R / S) And (P / Q) (T / U) Then Cell.AA2 = (J / K) Else:
If (R / S) (L / M) And (R / S) (N / O) And (R / S) (P / Q) And (R /
S)
(J / K) And (R / S) (T / U) Then Cell.AA2 = (R / S) Else:
If (T / U) (L / M) And (T / U) (N / O) And (T / U) (P / Q) And (T /
U)
(R / S) And (T / U) (J / K) Then Cell.AA2 = (T / U)
End If
End If
End If
End If
End If
End If
End If


Selection.AutoFill Destination:=Range("AA2:AA3943"), Type:=xlFillDefault
Range("AA2:AA3943").Select

End Sub

Block If
 

DA@PD:

If condition Then
[statements]
[ElseIf condition-n Then
[elseifstatements]...
[Else
[elsestatements]]
End If


Sub Usage()
Dim Usage As Double
Dim J As Double
Dim K As Double
Dim L As Double
Dim M As Double
Dim N As Double
Dim O As Double
Dim P As Double
Dim Q As Double
Dim R As Double
Dim S As Double
Dim T As Double
Dim U As Double
Dim W As Double
K = [K2]
L = [L2]
M = [M2]
N = [N2]
O = [O2]
P = [P2]
Q = [Q2]
R = [R2]
S = [S2]
T = [T2]
U = [U2]
W = [W2]
Usage = (K + M + O + Q + S + U) / 6
If Usage 20 Then
[AA2] = (W / 15)
ElseIf (J / K) (L / M) And (J / K) (N / O) And (J / K) (P / Q) And (J
/ K _
) (R / S) And (J / K) (T / U) Then
[AA2] = (J / K)
ElseIf (L / M) (J / K) And (L / M) (N / O) And (L / M) (P / Q) And (L
/ M _
) (R / S) And (L / M) (T / U) Then
[AA2] = (L / M)
ElseIf (N / O) (L / M) And (N / O) (J / K) And (N / O) (P / Q) And (N
/ O) _
(R / S) And (N / O) (T / U) Then
[AA2] = (N / O)
ElseIf (P / Q) (L / M) And (P / Q) (N / O) And (P / Q) (J / K) And (P
/ Q) _
(R / S) And (P / Q) (T / U) Then
[AA2] = (J / K)
ElseIf (R / S) (L / M) And (R / S) (N / O) And (R / S) (P / Q) And (R
/ S) _
(J / K) And (R / S) (T / U) Then
[AA2] = (R / S)
ElseIf (T / U) (L / M) And (T / U) (N / O) And (T / U) (P / Q) And (T
/ U) _
(R / S) And (T / U) (J / K) Then
[AA2] = (T / U)
Else
MsgBox "No"
End If
Selection.AutoFill Destination:=Range("AA2:AA3943"), Type:=xlFillDefault
Range("AA2:AA3943").Select
End Sub

--
天行å�¥ï¼Œå�›å*�以自強ä¸�æ�¯
地勢å�¤ï¼Œå�›å*�以厚德載物

http://www.vba.com.tw/plog/


"DA@PD" wrote:

I'm trying to create a really long =if command in Excel VBA editor but I keep
getting multiple errors, the latest is a "End if with no block If" error.
But I know I'm setting up the character values incorrectly also! Please
Help!!!

Sub Usage()

Dim Usage As Double
Dim J As Double
Dim K As Double
Dim L As Double
Dim M As Double
Dim N As Double
Dim O As Double
Dim P As Double
Dim Q As Double
Dim R As Double
Dim S As Double
Dim T As Double
Dim U As Double
Dim W As Double

K = Cell.K2
L = Cell.L2
M = Cell.M2
N = Cell.N2
O = Cell.O2
P = Cell.P2
Q = Cell.Q2
R = Cell.R2
S = Cell.S2
T = Cell.T2
U = Cell.U2
W = Cell.W2


Usage = (K + M + O + Q + S + U) / 6

If Usage 20 Then Cell.AA2 = (W / 15) Else:

If (J / K) (L / M) And (J / K) (N / O) And (J / K) (P / Q) And (J / K)
(R / S) And (J / K) (T / U) Then Cell.AA2 = (J / K) Else:
If (L / M) (J / K) And (L / M) (N / O) And (L / M) (P / Q) And (L / M)
(R / S) And (L / M) (T / U) Then Cell.AA2 = (L / M) Else:
If (N / O) (L / M) And (N / O) (J / K) And (N / O) (P / Q) And (N / O)
(R / S) And (N / O) (T / U) Then Cell.AA2 = (N / O) Else:
If (P / Q) (L / M) And (P / Q) (N / O) And (P / Q) (J / K) And (P / Q)
(R / S) And (P / Q) (T / U) Then Cell.AA2 = (J / K) Else:
If (R / S) (L / M) And (R / S) (N / O) And (R / S) (P / Q) And (R / S)
(J / K) And (R / S) (T / U) Then Cell.AA2 = (R / S) Else:
If (T / U) (L / M) And (T / U) (N / O) And (T / U) (P / Q) And (T / U)
(R / S) And (T / U) (J / K) Then Cell.AA2 = (T / U)
End If
End If
End If
End If
End If
End If
End If


Selection.AutoFill Destination:=Range("AA2:AA3943"), Type:=xlFillDefault
Range("AA2:AA3943").Select

End Sub

Block If
 

"DA@PD" wrote in message
...
I'm trying to create a really long =if command in Excel VBA editor but I
keep
getting multiple errors, the latest is a "End if with no block If" error.
But I know I'm setting up the character values incorrectly also!

If condition1 Then
action1
ElseIf condition2 Then
action2
ElseIf condition3 Then
action3
..
..
..
ElseIf conditionX Then
actionX
End If

Block If
 

Sub Usage()
Dim Usage As Double
Dim Counter1 As Byte
Dim Counter2 As Byte
Dim J As Double
Dim K As Double
Dim L As Double
Dim M As Double
Dim N As Double
Dim O As Double
Dim P As Double
Dim Q As Double
Dim R As Double
Dim S As Double
Dim T As Double
Dim U As Double
Dim W As Double
Dim Quotients(1 To 6) As Double
Dim QuotientMax As Double
J = Range("J2").Value
K = Range("K2").Value
L = Range("L2").Value
M = Range("M2").Value
N = Range("N2").Value
O = Range("O2").Value
P = Range("P2").Value
Q = Range("Q2").Value
R = Range("R2").Value
S = Range("S2").Value
T = Range("T2").Value
U = Range("U2").Value
W = Range("W2").Value
Usage = (K + M + O + Q + S + U) / 6
If Usage 20 Then
Range("AA2") = (W / 15)
Else: Counter2 = 10
For Counter1 = 1 To 6
Quotients(Counter1) = Cells(2, Counter2).Value / Cells(2, Counter2 + 1)
Counter2 = Counter2 + 2
Next Counter1
Range("AA2") = Application.Max(Quotients)
End If
Range("AA2").AutoFill Destination:=Range("AA2:AA3943"),
Type:=xlFillDefault
End Sub

I kept getting error with the filldown so I changed that to stop the
error but I'm not sure that you are intending for the value in AA2 to
be filled down to AA3943

I did it like this because it looked like you are wanting the maximum
out of J/K, L/M, N/O, P/Q, R/S and T/U to go into AA2 unless usage 20
(then AA2 = W/15)

Ken Johnson

Block If
 

Hi Darren,

Thanks for helping me classify the values!

"Darren Hill" wrote:

It looks like you're using the wrong syntax for cells.
If "K = Cell.K2" is supposed to assign the contents of K2 to the variable
K, you need to use the following syntax:

K = Range("K2").value
L = Range("L2").value
....

so also
If Usage 20 Then Cell.AA2 = (W / 15) Else:

becomes
If Usage 20 Then Range("AA2").value = (W / 15) Else:

You can use Cells(row,column) in place of Range(cell address)

Darren

On Fri, 16 Dec 2005 08:53:02 -0000, DA@PD""
wrote:

I'm trying to create a really long =if command in Excel VBA editor but I
keep
getting multiple errors, the latest is a "End if with no block If" error.
But I know I'm setting up the character values incorrectly also! Please
Help!!!

Sub Usage()

Dim Usage As Double
Dim J As Double
Dim K As Double
Dim L As Double
Dim M As Double
Dim N As Double
Dim O As Double
Dim P As Double
Dim Q As Double
Dim R As Double
Dim S As Double
Dim T As Double
Dim U As Double
Dim W As Double

K = Cell.K2
L = Cell.L2
M = Cell.M2
N = Cell.N2
O = Cell.O2
P = Cell.P2
Q = Cell.Q2
R = Cell.R2
S = Cell.S2
T = Cell.T2
U = Cell.U2
W = Cell.W2


Usage = (K + M + O + Q + S + U) / 6
If Usage 20 Then Cell.AA2 = (W / 15) Else:

If (J / K) (L / M) And (J / K) (N / O) And (J / K) (P / Q) And (J
/ K)
(R / S) And (J / K) (T / U) Then Cell.AA2 = (J / K) Else:
If (L / M) (J / K) And (L / M) (N / O) And (L / M) (P / Q) And (L
/ M)
(R / S) And (L / M) (T / U) Then Cell.AA2 = (L / M) Else:
If (N / O) (L / M) And (N / O) (J / K) And (N / O) (P / Q) And (N
/ O)
(R / S) And (N / O) (T / U) Then Cell.AA2 = (N / O) Else:
If (P / Q) (L / M) And (P / Q) (N / O) And (P / Q) (J / K) And (P
/ Q)
(R / S) And (P / Q) (T / U) Then Cell.AA2 = (J / K) Else:
If (R / S) (L / M) And (R / S) (N / O) And (R / S) (P / Q) And (R
/ S)
(J / K) And (R / S) (T / U) Then Cell.AA2 = (R / S) Else:
If (T / U) (L / M) And (T / U) (N / O) And (T / U) (P / Q) And (T
/ U)
(R / S) And (T / U) (J / K) Then Cell.AA2 = (T / U)
End If
End If
End If
End If
End If
End If
End If


Selection.AutoFill Destination:=Range("AA2:AA3943"), Type:=xlFillDefault
Range("AA2:AA3943").Select

End Sub




--
------------------
Darren

Block If
 

Hi Bob,

I think you've got something that I can follow pretty well, but when I run
this in place of what I had before (starting at the usage line), I get an
object required error at "Cell.AA2=(W/15), the third line of the script.

Any ideas???

"Bob Phillips" wrote:

This at least compiles and is somewhat more readable

Usage = (K + M + O + Q + S + U) / 6

If Usage 20 Then
Cell.AA2 = (W / 15)
ElseIf (J / K) (L / M) And (J / K) (N / O) And _
(J / K) (P / Q) And (J / K) (R / S) And _
(J / K) (T / U) Then
Cell.AA2 = (J / K)
ElseIf (L / M) (J / K) And (L / M) (N / O) And _
(L / M) (P / Q) And (L / M) (R / S) And _
(L / M) (T / U) Then Cell.AA2 = (L / M)
ElseIf (N / O) (L / M) And (N / O) (J / K) And _
(N / O) (P / Q) And (N / O) (R / S) And _
(N / O) (T / U) Then
Cell.AA2 = (N / O)
ElseIf (P / Q) (L / M) And (P / Q) (N / O) And _
(P / Q) (J / K) And (P / Q) (R / S) And _
(P / Q) (T / U) Then
Cell.AA2 = (J / K)
ElseIf (R / S) (L / M) And (R / S) (N / O) And _
(R / S) (P / Q) And (R / S) (J / K) And _
(R / S) (T / U) Then
Cell.AA2 = (R / S)
ElseIf (T / U) (L / M) And (T / U) (N / O) And _
(T / U) (P / Q) And (T / U) (R / S) And _
(T / U) (J / K) Then
Cell.AA2 = (T / U)
End If


--

HTH

RP
(remove nothere from the email address if mailing direct)


"DA@PD" wrote in message
...
I'm trying to create a really long =if command in Excel VBA editor but I
keep
getting multiple errors, the latest is a "End if with no block If" error.
But I know I'm setting up the character values incorrectly also! Please
Help!!!

Sub Usage()

Dim Usage As Double
Dim J As Double
Dim K As Double
Dim L As Double
Dim M As Double
Dim N As Double
Dim O As Double
Dim P As Double
Dim Q As Double
Dim R As Double
Dim S As Double
Dim T As Double
Dim U As Double
Dim W As Double

K = Cell.K2
L = Cell.L2
M = Cell.M2
N = Cell.N2
O = Cell.O2
P = Cell.P2
Q = Cell.Q2
R = Cell.R2
S = Cell.S2
T = Cell.T2
U = Cell.U2
W = Cell.W2


Usage = (K + M + O + Q + S + U) / 6

If Usage 20 Then Cell.AA2 = (W / 15) Else:

If (J / K) (L / M) And (J / K) (N / O) And (J / K) (P / Q) And (J /
K)
(R / S) And (J / K) (T / U) Then Cell.AA2 = (J / K) Else:
If (L / M) (J / K) And (L / M) (N / O) And (L / M) (P / Q) And (L /
M)
(R / S) And (L / M) (T / U) Then Cell.AA2 = (L / M) Else:
If (N / O) (L / M) And (N / O) (J / K) And (N / O) (P / Q) And (N /
O)
(R / S) And (N / O) (T / U) Then Cell.AA2 = (N / O) Else:
If (P / Q) (L / M) And (P / Q) (N / O) And (P / Q) (J / K) And (P /
Q)
(R / S) And (P / Q) (T / U) Then Cell.AA2 = (J / K) Else:
If (R / S) (L / M) And (R / S) (N / O) And (R / S) (P / Q) And (R /
S)
(J / K) And (R / S) (T / U) Then Cell.AA2 = (R / S) Else:
If (T / U) (L / M) And (T / U) (N / O) And (T / U) (P / Q) And (T /
U)
(R / S) And (T / U) (J / K) Then Cell.AA2 = (T / U)
End If
End If
End If
End If
End If
End If
End If


Selection.AutoFill Destination:=Range("AA2:AA3943"), Type:=xlFillDefault
Range("AA2:AA3943").Select

End Sub

Block If
 

(Hi Ken,

You certainly understand what I'm trying to do here, you are correct, I
don't want to have the contents in AA2 to just be posting in the subsequent
3,000 rows, I'd like the same type of calculation to be run on all of the
rows. Your programing is quite a bit above mine, so I couldn't really follow
the counters and quotiants, but I did try to run the script, but I kept
erroring with the fill down, so I just took it out, and now it gives me an
"object required" error on the "Range.("AA2")=W/15" line
any ideas why? Thanks for the help!

David

"Ken Johnson" wrote:

Sub Usage()
Dim Usage As Double
Dim Counter1 As Byte
Dim Counter2 As Byte
Dim J As Double
Dim K As Double
Dim L As Double
Dim M As Double
Dim N As Double
Dim O As Double
Dim P As Double
Dim Q As Double
Dim R As Double
Dim S As Double
Dim T As Double
Dim U As Double
Dim W As Double
Dim Quotients(1 To 6) As Double
Dim QuotientMax As Double
J = Range("J2").Value
K = Range("K2").Value
L = Range("L2").Value
M = Range("M2").Value
N = Range("N2").Value
O = Range("O2").Value
P = Range("P2").Value
Q = Range("Q2").Value
R = Range("R2").Value
S = Range("S2").Value
T = Range("T2").Value
U = Range("U2").Value
W = Range("W2").Value
Usage = (K + M + O + Q + S + U) / 6
If Usage 20 Then
Range("AA2") = (W / 15)
Else: Counter2 = 10
For Counter1 = 1 To 6
Quotients(Counter1) = Cells(2, Counter2).Value / Cells(2, Counter2 + 1)
Counter2 = Counter2 + 2
Next Counter1
Range("AA2") = Application.Max(Quotients)
End If
Range("AA2").AutoFill Destination:=Range("AA2:AA3943"),
Type:=xlFillDefault
End Sub

I kept getting error with the filldown so I changed that to stop the
error but I'm not sure that you are intending for the value in AA2 to
be filled down to AA3943

I did it like this because it looked like you are wanting the maximum
out of J/K, L/M, N/O, P/Q, R/S and T/U to go into AA2 unless usage 20
(then AA2 = W/15)

Ken Johnson

Block If
 

Regarding the filldown - if you copied the code from the email, Excel has
probably split the following into two lines:

Range("AA2").AutoFill Destination:=Range("AA2:AA3943"), Type:=xlFillDefault

It should be a single line - remove the line break and it'll be okay.

However, since it looks like you want to repeat this calculation across a
multiple rows, the filldown won't give you the result you are after.
Filldown will only copy what is in the cell - you won't have a formula in
the copied cell, you'll just have a result. You'll end up copying that
same result all the way down.

So, you need a different approach. Either a macro to install a (pretty
complex) formula into all the cells needed, or a loop in the code to
repeat the calculation for each of the required rows.

Can you explain, in fairly plain english, what it is exactly you need to
do and we'll be able to help better.


On Fri, 16 Dec 2005 18:01:01 -0000, DA@PD""
wrote:

(Hi Ken,

You certainly understand what I'm trying to do here, you are correct, I
don't want to have the contents in AA2 to just be posting in the
subsequent
3,000 rows, I'd like the same type of calculation to be run on all of the
rows. Your programing is quite a bit above mine, so I couldn't really
follow
the counters and quotiants, but I did try to run the script, but I kept
erroring with the fill down, so I just took it out, and now it gives me
an
"object required" error on the "Range.("AA2")=W/15" line
any ideas why? Thanks for the help!

David

Darren

Block If
 

Hi David,
Is that "." between "Range" and "(AA2")=W/15" in your code or just a
typo in your post?
When I add the "." it gives a Syntax Error and the code can't even be
started.
Ken Johnson

Block If
 

Does this do what you want?

(WARNING: if you have any zeros in k, M, O, Q, S, or U it'll fail - if
this does what yo uwant, we can add error handling code)

Sub Usage()

Dim Usage As Double
Dim J As Double
Dim K As Double
Dim L As Double
Dim M As Double
Dim N As Double
Dim O As Double
Dim P As Double
Dim Q As Double
Dim R As Double
Dim S As Double
Dim T As Double
Dim U As Double
Dim W As Double
Dim JK As Double
Dim LM As Double
Dim NO As Double
Dim PQ As Double
Dim RS As Double
Dim TU As Double
Dim fn As WorksheetFunction
Dim myResult As Double
Dim i As Long

Set fn = Application.WorksheetFunction
For i = 2 To 3943

J = Range("J" & i).Value
K = Range("K" & i).Value
L = Range("L" & i).Value
M = Range("M" & i).Value
N = Range("N" & i).Value
O = Range("O" & i).Value
P = Range("P" & i).Value
Q = Range("Q" & i).Value
R = Range("R" & i).Value
S = Range("S" & i).Value
T = Range("T" & i).Value
U = Range("U" & i).Value
W = Range("W" & i).Value

JK = J / K
LM = L / M
NO = N / O
PQ = P / Q
RS = R / S
TU = T / U


Usage = (K + M + O + Q + S + U) / 6


If Usage 20 Then
myResult = (W / 15)
ElseIf JK fn.Max(LM, NO, PQ, RS, TU) Then
myResult = JK
ElseIf LM fn.Max(JK, NO, PQ, RS, TU) Then
myResult = LM
ElseIf NO fn.Max(JK, LM, PQ, RS, TU) Then
myResult = NO
ElseIf PQ fn.Max(JK, LM, NO, RS, TU) Then
myResult = PQ
ElseIf RS fn.Max(JK, LM, NO, PQ, TU) Then
myResult = RS
ElseIf TU fn.Max(JK, LM, NO, PQ, RS) Then
myResult = TU
End If
Range("AA" & i).Value = myResult

Next i
Range("AA2:AA3943").Select

End Sub


On Fri, 16 Dec 2005 18:01:01 -0000, DA@PD""
wrote:

(Hi Ken,

You certainly understand what I'm trying to do here, you are correct, I
don't want to have the contents in AA2 to just be posting in the
subsequent
3,000 rows, I'd like the same type of calculation to be run on all of the
rows. Your programing is quite a bit above mine, so I couldn't really
follow
the counters and quotiants, but I did try to run the script, but I kept
erroring with the fill down, so I just took it out, and now it gives me
an
"object required" error on the "Range.("AA2")=W/15" line
any ideas why? Thanks for the help!

David

"Ken Johnson" wrote:

Sub Usage()
Dim Usage As Double
Dim Counter1 As Byte
Dim Counter2 As Byte
Dim J As Double
Dim K As Double
Dim L As Double
Dim M As Double
Dim N As Double
Dim O As Double
Dim P As Double
Dim Q As Double
Dim R As Double
Dim S As Double
Dim T As Double
Dim U As Double
Dim W As Double
Dim Quotients(1 To 6) As Double
Dim QuotientMax As Double
J = Range("J2").Value
K = Range("K2").Value
L = Range("L2").Value
M = Range("M2").Value
N = Range("N2").Value
O = Range("O2").Value
P = Range("P2").Value
Q = Range("Q2").Value
R = Range("R2").Value
S = Range("S2").Value
T = Range("T2").Value
U = Range("U2").Value
W = Range("W2").Value
Usage = (K + M + O + Q + S + U) / 6
If Usage 20 Then
Range("AA2") = (W / 15)
Else: Counter2 = 10
For Counter1 = 1 To 6
Quotients(Counter1) = Cells(2, Counter2).Value / Cells(2, Counter2 + 1)
Counter2 = Counter2 + 2
Next Counter1
Range("AA2") = Application.Max(Quotients)
End If
Range("AA2").AutoFill Destination:=Range("AA2:AA3943"),
Type:=xlFillDefault
End Sub

I kept getting error with the filldown so I changed that to stop the
error but I'm not sure that you are intending for the value in AA2 to
be filled down to AA3943

I did it like this because it looked like you are wanting the maximum
out of J/K, L/M, N/O, P/Q, R/S and T/U to go into AA2 unless usage 20
(then AA2 = W/15)

Ken Johnson





--
------------------
Darren

Block If
 

Hi David,
Or this? Which probably does the same as Darren's and can result in
Division by zero error if Quotient calculation involves division by a
cell with value = zero.

Sub Usage()
Dim Usage As Double
Dim Counter1 As Byte
Dim Counter2 As Byte
Dim Counter3 As Long
Dim J As Double
Dim K As Double
Dim L As Double
Dim M As Double
Dim N As Double
Dim O As Double
Dim P As Double
Dim Q As Double
Dim R As Double
Dim S As Double
Dim T As Double
Dim U As Double
Dim W As Double
Dim Quotients(1 To 6) As Double
Dim QuotientMax As Double
For Counter3 = 2 To 3943
J = Cells(Counter3, 10).Value
K = Cells(Counter3, 11).Value
L = Cells(Counter3, 12).Value
M = Cells(Counter3, 13).Value
N = Cells(Counter3, 14).Value
O = Cells(Counter3, 15).Value
P = Cells(Counter3, 16).Value
Q = Cells(Counter3, 17).Value
R = Cells(Counter3, 18).Value
S = Cells(Counter3, 19).Value
T = Cells(Counter3, 20).Value
U = Cells(Counter3, 21).Value
W = Cells(Counter3, 22).Value
Usage = (K + M + O + Q + S + U) / 50
If Usage 20 Then
Cells(Counter3, 27) = (W / 15)
Else: Counter2 = 10
For Counter1 = 1 To 6
Quotients(Counter1) = Cells(Counter3, Counter2).Value / Cells(Counter3,
Counter2 + 1)
Counter2 = Counter2 + 2
Next Counter1
Cells(Counter3, 27) = Application.Max(Quotients)
For Counter1 = 1 To 6
Quotients(Counter1) = 0
Next Counter1
End If
Next Counter3
End Sub

Ken Johnson

Block If
 

Aha, I can beat that! (Just kidding :))

David, Ken's method is actually much better than mine, but mine might be
easier to follow. (It is for me!)
I've also added something to avoid the divide by zero error, if that's
something that might happen.

In the section of code where I had
JK = J / K
LM = L / M
and so on, replace with:

JK = PerformDivision(J, K)
LM = PerformDivision(L, M)
NO = PerformDivision(N, O)
PQ = PerformDivision(P, Q)
RS = PerformDivision(R, S)
TU = PerformDivision(T, U)

Then add this function to the module:

Function PerformDivision(Numerator As Double, Divisor As Double) As Double

If Divisor = 0 Or Numerator = 0 Then
PerformDivision = 0
Else
PerformDivision = Numerator / Divisor
End If
End Function

Then, I'd probably add some conditional formatting to your table to
highlight any empty or zero cells.

On Fri, 16 Dec 2005 23:55:52 -0000, Ken Johnson
wrote:

Hi David,
Or this? Which probably does the same as Darren's and can result in
Division by zero error if Quotient calculation involves division by a
cell with value = zero.

Sub Usage()
Dim Usage As Double
Dim Counter1 As Byte
Dim Counter2 As Byte
Dim Counter3 As Long
Dim J As Double
Dim K As Double
Dim L As Double
Dim M As Double
Dim N As Double
Dim O As Double
Dim P As Double
Dim Q As Double
Dim R As Double
Dim S As Double
Dim T As Double
Dim U As Double
Dim W As Double
Dim Quotients(1 To 6) As Double
Dim QuotientMax As Double
For Counter3 = 2 To 3943
J = Cells(Counter3, 10).Value
K = Cells(Counter3, 11).Value
L = Cells(Counter3, 12).Value
M = Cells(Counter3, 13).Value
N = Cells(Counter3, 14).Value
O = Cells(Counter3, 15).Value
P = Cells(Counter3, 16).Value
Q = Cells(Counter3, 17).Value
R = Cells(Counter3, 18).Value
S = Cells(Counter3, 19).Value
T = Cells(Counter3, 20).Value
U = Cells(Counter3, 21).Value
W = Cells(Counter3, 22).Value
Usage = (K + M + O + Q + S + U) / 50
If Usage 20 Then
Cells(Counter3, 27) = (W / 15)
Else: Counter2 = 10
For Counter1 = 1 To 6
Quotients(Counter1) = Cells(Counter3, Counter2).Value / Cells(Counter3,
Counter2 + 1)
Counter2 = Counter2 + 2
Next Counter1
Cells(Counter3, 27) = Application.Max(Quotients)
For Counter1 = 1 To 6
Quotients(Counter1) = 0
Next Counter1
End If
Next Counter3
End Sub

Ken Johnson




--
------------------
Darren

Block If
 

Hi Darren and David,
Ignore my code!
two reasons (I think)
1. I was fiddling around with "6" in "Usage = (K + M + O + Q + S + U) /
6". I changed it to 50 to force the code through the Usage <= 20
section (using my sheet values) and forgot to change it back.

2. Darren and I get different results in column AA and I think my code
has a problem because column V is not included.

Darren's code is easier to follow (only 1 loop) and is more than likely
producing the desired result.

Well done Darren!

Ken Johnson

Block If
 

Hi Darren and David,

Wasn't such a big problem after all!
Where I should have been referencing column W (Column 23), I was
accidentally referencing column V (column 22), and luckily this
reference is only in the main loop.
If it occurred in the other loops my code would have been further
complicated by the addition of If statements. So I only had to change a
"22" to a "23" and that solved that problem.

I have also:
1. Fixed up the "6" that I had changed to a "50"
2. Added "On Error Resume Next" to deal with division by zero
errors
3. Added Application.ScreenUpdating = False to significantly speed up
the code.

However, I would still use your code Darren! It's easier to fix up
future problem simply because it's easier to follow.

Sub Usage()
Application.ScreenUpdating = False
Dim Usage As Double
Dim Counter1 As Byte
Dim Counter2 As Long
Dim Counter3 As Long
Dim J As Double
Dim K As Double
Dim L As Double
Dim M As Double
Dim N As Double
Dim O As Double
Dim P As Double
Dim Q As Double
Dim R As Double
Dim S As Double
Dim T As Double
Dim U As Double
Dim W As Double
Dim Quotients(1 To 6) As Double
Dim QuotientMax As Double
On Error Resume Next
For Counter3 = 2 To 3943
J = Cells(Counter3, 10).Value
K = Cells(Counter3, 11).Value
L = Cells(Counter3, 12).Value
M = Cells(Counter3, 13).Value
N = Cells(Counter3, 14).Value
O = Cells(Counter3, 15).Value
P = Cells(Counter3, 16).Value
Q = Cells(Counter3, 17).Value
R = Cells(Counter3, 18).Value
S = Cells(Counter3, 19).Value
T = Cells(Counter3, 20).Value
U = Cells(Counter3, 21).Value
W = Cells(Counter3, 23).Value
Usage = (K + M + O + Q + S + U) / 6
If Usage 20 Then
Cells(Counter3, 27) = (W / 15)
Else: Counter2 = 10
For Counter1 = 1 To 6
Quotients(Counter1) = Cells(Counter3, Counter2).Value / Cells(Counter3,
Counter2 + 1)
Counter2 = Counter2 + 2
Next Counter1
Cells(Counter3, 27) = Application.Max(Quotients)
For Counter1 = 1 To 6
Quotients(Counter1) = 0
Next Counter1
End If
Next Counter3
On Error GoTo 0
End Sub

Ken Johnson

PS I'm getting a lot of Google Groups Server Errors today. It's so
annoying having to do things more than once. I've resorted to typing
my posts in Word then pasting into Groups.

Block If
 

Hi Ken,
I can see how that 22/23 error crept in - the amount of times I've mucked
up referring to columns by numbers. Grrr.
I like the way you solved the Divide by zero problem.
David, if you do use my code or some variant of it, it's a good idea to
stick Ken's line:
Application.ScreeenUpdating = False
at the start. It's handy in any macro which modifies a lot of worksheet
cells - it can make a massive speed difference.

I usually put
Application.ScreeenUpdating = True
at the end of the code, just before End Sub, to reset it. Apparently it's
not actually necessary, Excel should reset itself automatically. It's that
"should" that worries me :). Maybe earlier versions than xl2002 needed it?

Darren
On Sat, 17 Dec 2005 01:19:08 -0000, Ken Johnson
wrote:

Hi Darren and David,

Wasn't such a big problem after all!
Where I should have been referencing column W (Column 23), I was
accidentally referencing column V (column 22), and luckily this
reference is only in the main loop.
If it occurred in the other loops my code would have been further
complicated by the addition of If statements. So I only had to change a
"22" to a "23" and that solved that problem.

I have also:
1. Fixed up the "6" that I had changed to a "50"
2. Added "On Error Resume Next" to deal with division by zero
errors
3. Added Application.ScreenUpdating = False to significantly speed up
the code.

However, I would still use your code Darren! It's easier to fix up
future problem simply because it's easier to follow.

Sub Usage()
Application.ScreenUpdating = False
Dim Usage As Double
Dim Counter1 As Byte
Dim Counter2 As Long
Dim Counter3 As Long
Dim J As Double
Dim K As Double
Dim L As Double
Dim M As Double
Dim N As Double
Dim O As Double
Dim P As Double
Dim Q As Double
Dim R As Double
Dim S As Double
Dim T As Double
Dim U As Double
Dim W As Double
Dim Quotients(1 To 6) As Double
Dim QuotientMax As Double
On Error Resume Next
For Counter3 = 2 To 3943
J = Cells(Counter3, 10).Value
K = Cells(Counter3, 11).Value
L = Cells(Counter3, 12).Value
M = Cells(Counter3, 13).Value
N = Cells(Counter3, 14).Value
O = Cells(Counter3, 15).Value
P = Cells(Counter3, 16).Value
Q = Cells(Counter3, 17).Value
R = Cells(Counter3, 18).Value
S = Cells(Counter3, 19).Value
T = Cells(Counter3, 20).Value
U = Cells(Counter3, 21).Value
W = Cells(Counter3, 23).Value
Usage = (K + M + O + Q + S + U) / 6
If Usage 20 Then
Cells(Counter3, 27) = (W / 15)
Else: Counter2 = 10
For Counter1 = 1 To 6
Quotients(Counter1) = Cells(Counter3, Counter2).Value / Cells(Counter3,
Counter2 + 1)
Counter2 = Counter2 + 2
Next Counter1
Cells(Counter3, 27) = Application.Max(Quotients)
For Counter1 = 1 To 6
Quotients(Counter1) = 0
Next Counter1
End If
Next Counter3
On Error GoTo 0
End Sub

Ken Johnson

PS I'm getting a lot of Google Groups Server Errors today. It's so
annoying having to do things more than once. I've resorted to typing
my posts in Word then pasting into Groups.




--
------------------
Darren