Solved: Error "400" in VBA

[fiamia]

Hi!

We've created a code, below, but we get the error message "400".
Does anyone know where our mistakes are?

Thank you!


Sub AWHS()
Sheet1.Select
Application.ScreenUpdating = True
Dim Ra As Range
Dim Rb As Range
Dim R As Range
Dim WS As Worksheet ' temporary worksheet
Dim kumsum As Double
Dim lnum As Integer
Dim var(1 To 49) As Double
Dim varlevel As Double
Dim i As Integer
Dim j As Integer
Dim weighta As Variant
Dim l As Integer

For i = 1 To 3130
ReDim Data(i) As Variant
Data(i) = Cells(i, 2)
Next i

For i = 2609 To 3130

weighta = ((1 - 0.999) / (1 - 0.999 ^ (i - 1)))
ReDim Data(1 To i - 1) As Variant
ReDim Weight(1 To i - 1) As Variant


' create a new sheet


For j = 1 To i - 1 ' changed from -1

Data(j) = Cells(j, 2)
Weight(j) = weighta * 0.999 ^ (i - j - 1)


' put the array values on the worksheet

Next j

varlevel = 0.01
Application.ScreenUpdating = False
Set WS = ThisWorkbook.Worksheets.Add
Set Ra = WS.Range("A1").Resize(UBound(Data) - LBound(Data) + 1, 1)
Ra = Application.Transpose(Data)
Set Rb = WS.Range("b1").Resize(UBound(Data) - LBound(Data) + 1, 1)
Rb = Application.Transpose(Weight)
Set R = WS.Range("a1").Resize(UBound(Data) - LBound(Data) + 1, 2)
' sort the range
R.Sort key1:=Ra, order1:=xlAscending, MatchCase:=False
kumsum = WS.Cells(1, 2)
lnum = 1
Do While kumsum < varlevel ' 0.01 is the VaR level (or 1 - VaR to be precise)
lnum = lnum + 1
kumsum = kumsum + WS.Cells(lnum, 2)
Loop
ReDim rets(lnum) As Double

For k = Inum To lnum
rets(k) = WS.Cells(Inum, 2)

Next k
Application.DisplayAlerts = False
WS.Delete
Application.DisplayAlerts = True



Application.ScreenUpdating = True
Cells(i - 2608, 3) = rets(k)
Next i
End Sub

[GTO]

Greetings,

I did not read well enough to follow what was happening, but the first error I got was 1004/Application defined or Object defined error at the below line.

This is because 'Inum' is inially zero, thus 'WS.Cells(Inum, 2)' first refers to Row 0, which of course does not exist.

You also had not declared:

Dim k As Long, Inum As Long


I would suggest using Option Explicit, as requiring variable declaration can save headaches IMO.

Mark

[fiamia]

We did a similar macro before. You can see it below (here starts the data at row 3 instead). The original macro worked perfectly fine. In that one, we wanted to have "Sum(rets)" as the final outcome (that is an average of an interval).

In the macro posted earlier, we want the final outcome to be; "WS.Cells(Inum,2)", which is the last value included in the interval (above) ("Do while kumsum).

Hard to explain, but if you look at the two macros and the changes we made, maybe it clearer to see the faults we made. ( The only changes we made were in the last part, where we try to get "WS.Cells(Inum,2)" as final output instead of "Sum(rets) / varlevel"., and not in the first part where we get the error message)


And, thank you very much for your help!

First, working macro
Sub AWHS()

Blad5.Select
Application.ScreenUpdating = True
Dim Ra As Range
Dim Rb As Range
Dim R As Range
Dim WS As Worksheet ' temporary worksheet
Dim kumsum As Double
Dim lnum As Integer
Dim var(1 To 49) As Double
Dim varlevel As Double
Dim i As Integer
Dim j As Integer
Dim weighta As Variant
Dim l As Integer

For i = 3 To 3132
ReDim data(i) As Variant
data(i) = Cells(i + 2, 2)
Next i
For i = 2611 To 3132

weighta = ((1 - 0.999) / (1 - 0.999 ^ (i - 3)))
ReDim data(1 To i - 1) As Variant
ReDim Weight(1 To i - 1) As Variant

' create a new sheet
For j = 1 To i - 3 ' changed from -1
data(j) = Cells(j + 2, 2)
Weight(j) = weighta * 0.999 ^ (i - j - 3)
' put the array values on the worksheet
Next j
varlevel = 0.01
Application.ScreenUpdating = False
Set WS = ThisWorkbook.Worksheets.Add
Set Ra = WS.Range("A1").Resize(UBound(data) - LBound(data) + 1, 1)
Ra = Application.Transpose(data)
Set Rb = WS.Range("b1").Resize(UBound(data) - LBound(data) + 1, 1)
Rb = Application.Transpose(Weight)
Set R = WS.Range("a1").Resize(UBound(data) - LBound(data) + 1, 2)
' sort the range
R.Sort key1:=Ra, order1:=xlAscending, MatchCase:=False
kumsum = WS.Cells(1, 2)
lnum = 1
Do While kumsum < varlevel ' 0.01 is the VaR level (or 1 - VaR to be precise)
lnum = lnum + 1
kumsum = kumsum + WS.Cells(lnum, 2)
Loop
ReDim rets(1 To lnum) As Double

For k = 1 To lnum
rets(k) = WS.Cells(k, 1) * WS.Cells(k, 2)

Next k
Application.DisplayAlerts = False
WS.Delete
Application.DisplayAlerts = True

Application.ScreenUpdating = True
es = Application.WorksheetFunction.Sum(rets) / varlevel
Cells(i - 2608, 41) = es
Next i
End Sub

[GTO]

If you use the little green and white 'VBA' button above where you type the msg and put your code in between the vba tags...
'your code here
... it makes it a lot easier to read. I believe you may still be able to edit your last post.

As to the error, not sure I have time to look right now, but please show what line it is on.

Mark

Edit: three tries to get simple tags in... I'm certainly not buying any lotto tickets tonight...

[fiamia]

This is the correct macro.

Sub AWHS()

Blad5.Select
Application.ScreenUpdating = True
Dim Ra As Range
Dim Rb As Range
Dim R As Range
Dim WS As Worksheet ' temporary worksheet
Dim kumsum As Double
Dim lnum As Integer
Dim var(1 To 49) As Double
Dim varlevel As Double
Dim i As Integer
Dim j As Integer
Dim weighta As Variant
Dim l As Integer

For i = 3 To 3132
ReDim data(i) As Variant
data(i) = Cells(i + 2, 2)
Next i
For i = 2611 To 3132

weighta = ((1 - 0.999) / (1 - 0.999 ^ (i - 3)))
ReDim data(1 To i - 1) As Variant
ReDim Weight(1 To i - 1) As Variant

' create a new sheet
For j = 1 To i - 3 ' changed from -1
data(j) = Cells(j + 2, 2)
Weight(j) = weighta * 0.999 ^ (i - j - 3)
' put the array values on the worksheet
Next j
varlevel = 0.01
Application.ScreenUpdating = False
Set WS = ThisWorkbook.Worksheets.Add
Set Ra = WS.Range("A1").Resize(UBound(data) - LBound(data) + 1, 1)
Ra = Application.Transpose(data)
Set Rb = WS.Range("b1").Resize(UBound(data) - LBound(data) + 1, 1)
Rb = Application.Transpose(Weight)
Set R = WS.Range("a1").Resize(UBound(data) - LBound(data) + 1, 2)
' sort the range
R.Sort key1:=Ra, order1:=xlAscending, MatchCase:=False
kumsum = WS.Cells(1, 2)
lnum = 1
Do While kumsum < varlevel ' 0.01 is the VaR level (or 1 - VaR to be precise)
lnum = lnum + 1
kumsum = kumsum + WS.Cells(lnum, 2)
Loop
ReDim rets(1 To lnum) As Double

For k = 1 To lnum
rets(k) = WS.Cells(k, 1) * WS.Cells(k, 2)

Next k
Application.DisplayAlerts = False
WS.Delete
Application.DisplayAlerts = True

Application.ScreenUpdating = True
es = Application.WorksheetFunction.Sum(rets) / varlevel
Cells(i - 2608, 41) = es
Next i
End Sub

The incorrect macro
Sub AWHS()
Sheet1.Select
Application.ScreenUpdating = True
Dim Ra As Range
Dim Rb As Range
Dim R As Range
Dim WS As Worksheet ' temporary worksheet
Dim kumsum As Double
Dim lnum As Integer
Dim var(1 To 49) As Double
Dim varlevel As Double
Dim i As Integer
Dim j As Integer
Dim weighta As Variant
Dim l As Integer

For i = 1 To 3130
ReDim Data(i) As Variant
Data(i) = Cells(i, 2)
Next i

For i = 2609 To 3130

weighta = ((1 - 0.999) / (1 - 0.999 ^ (i - 1)))
ReDim Data(1 To i - 1) As Variant
ReDim Weight(1 To i - 1) As Variant


' create a new sheet


For j = 1 To i - 1 ' changed from -1

Data(j) = Cells(j, 2)
Weight(j) = weighta * 0.999 ^ (i - j - 1)


' put the array values on the worksheet

Next j

varlevel = 0.01
Application.ScreenUpdating = False
Set WS = ThisWorkbook.Worksheets.Add
Set Ra = WS.Range("A1").Resize(UBound(Data) - LBound(Data) + 1, 1)
Ra = Application.Transpose(Data)
Set Rb = WS.Range("b1").Resize(UBound(Data) - LBound(Data) + 1, 1)
Rb = Application.Transpose(Weight)
Set R = WS.Range("a1").Resize(UBound(Data) - LBound(Data) + 1, 2)
' sort the range
R.Sort key1:=Ra, order1:=xlAscending, MatchCase:=False
kumsum = WS.Cells(1, 2)
lnum = 1
Do While kumsum < varlevel ' 0.01 is the VaR level (or 1 - VaR to be precise)
lnum = lnum + 1
kumsum = kumsum + WS.Cells(lnum, 2)
Loop
ReDim rets(lnum) As Double

For k = Inum To lnum
rets(k) = WS.Cells(Inum, 2)

Next k
Application.DisplayAlerts = False
WS.Delete
Application.DisplayAlerts = True



Application.ScreenUpdating = True
Cells(i - 2608, 3) = rets(k)
Next i
End Sub

We also tried your F8 soultion, but why does it stop there? HAven't done this before, so nothing seems logical...

[GTO]

Hi there,

Unfortunately, I may well be done for the day; been up since yesterday.

The F8 was not a solution, I simply stepped past the last break I inserted, so that the line would be highlighted.

I see that you are now starting the loop at '1', so it seems to run, but I am not quite sure what it is doing. The final vals being returned be 'es' seemed to be getting planted on Sheet1 from your attached wb (I just changed Blad to Sheet), though I don't see why, as the only sheet I see referenced is the newly created one. I could very well be missing stuff at this point though.

Are you still getting an error?

Mark

[p45cal]

Well... where to start?

Two points about Data():
1. This bit of code:
For i = 1 To 3130
ReDim Data(i) As Variant
Data(i) = Cells(i, 2)
Next imakes heavy weather of putting just one value in Data(3130); the rest are empty, regardless of whats in the sheet. This is because at every iteration of the loop you are reDiming Data() which also clears it, you need Redim Preserve to retain values.
Since you've hard coded 1 to 3130, why don't you
ReDim Data(1 To 3130)
For i = 1 To 3130
Data(i) = Cells(i, 2)
Next i
(By the way, there's a slicker way to put values into an array:
myData = Application.Transpose(Range("B1:B3130"))
does pretty much the same thing in one line.)
2. However, the result of (1) above, even if adjusted, is obliterated before being used because 3 lines later:
ReDim Data(1 To i - 1) As Variantagain clears Data().

Next, I'm likely to be wrong here since I don't know what you're trying to do, but I see:
1-var
1-0.999
and the like, but I also see:
varlevel = 0.01
I'm just wondering whether it's relevant that
1-0.999 = 0.001 and not 0.01?

The next thing is:For k = Inum To lnum
rets(k) = WS.Cells(Inum, 2)
Next k which is very different from your correct version's code:
For k = 1 To lnum
rets(k) = WS.Cells(k, 1) * WS.Cells(k, 2)
Next k In the first you use Inum which isn't defined, what's more it doesn't change with each iteration of the loop but is used within the loop. This will definitely error out.
In the second, you multiply 2 values which you don't do in the first.

Next, there's a big difference in what you eventually try to write to the sheet; in the incorrect version you have:Cells(i - 2608, 3) = rets(k)
which is guaranteed to fall over because at this stage k will have a value of lnum +1 (because it was the loop control variable in the For Next loop) so rets(k) will cause an error because rets is only Dimmed up to lnum.

I think this macro has become more convoluted than needs be, so what are you trying to do?! I'm sure we can make it much more robust.

Finally, a small thing, you have Application.ScreenUpdating = False and Application.ScreenUpdating = True within a loop which loop some 500
time, it might be better to have them outside the loop.

GTO/Mark:
re:
The final vals being returned be 'es' seemed to be getting planted on Sheet1 from your attached wb (I just changed Blad to Sheet), though I don't see why, as the only sheet I see referenced is the newly created one. I could very well be missing stuff at this point though.
Mark The code is housed in sheet1's code module, so regardless of which sheet is the active sheet,
Cells(i - 2608, 41) = es
still refers to that sheet1.

[GTO]

GTO/Mark:
re: The code is housed in sheet1's code module, so regardless of which sheet is the active sheet,
Cells(i - 2608, 41) = es
still refers to that sheet1.

Thank you much for including that info Pascal. While (please do not take offense piamia) I was too overwhelmed to catch what I might normally, I did not know that an unqualified range would automatically belong to the class' object. It of course makes perfect sense, but I did not know and a nice gain for me.

Thanks,

Mark

[Aussiebear]

The #7 post is a terrific example for others to follow. Well done Pascal.:friends:

[p45cal]

Ta for that.. it's just a shame the OP hasn't seen it/has fallen ill/can't be bothered even to acknowledge it.. who knows?

Sometimes I wonder why I effing bother..
..and should I continue to bother?


The #7 post is a terrific example for others to follow. Well done Pascal.:friends:

[Paul_Hossler]

..and should I continue to bother?


Yes, the rest of us appreciate your time and your efforts.

I usually learn something by following the threads


Paul

[GTO]

A hearty second on that! #8 would just be one example of where I have benefitted :-)

[Aussiebear]

In the absence of the OP I have marked this thread as solved.