Unable to run VBA macro from certain sheets [duplicate] - vba

This question already has an answer here:
Why does Range work, but not Cells?
(1 answer)
Closed 5 years ago.
I am fairly new to VBA and been trying to automate some financial reports. Below is the subprocedure that I have:
Sub normdata()
Dim numofstocks As Integer
Dim numofdatapoints As Integer
Dim numberofiterations As Integer
Dim averageposition As Integer
numofstocks = Application.CountA(Sheets("Static").Range("B:B")) - 1
Sheets("NormData").Range("A2").Value = "Date"
For i = 1 To numofstocks
Sheets("NormData").Cells(1, 2 * (i - 1) + 2).Value = Sheets("Static").Cells(i + 1, 1)
Sheets("NormData").Cells(2, 2 * (i - 1) + 2).Value = "Close"
Sheets("NormData").Cells(2, 2 * (i - 1) + 3).Value = "Returns"
Next i
numofdatapoints = Application.CountA(Sheets("RawData").Range("A:A")) - 2
For i = 1 To numofdatapoints
Sheets("NormData").Cells(i + 2, 1).Value = Sheets("RawData").Cells(i + 2, 1).Value
Next i
For j = 1 To numofstocks
For i = 1 To numofdatapoints
Sheets("NormData").Cells(i + 2, 2 * (j - 1) + 2).Value = Sheets("RawData").Cells(i + 2, 6 * (j - 1) + 5).Value
Next i
Next j
numberofiterations = Application.CountA(Sheets("RawData").Range("A:A")) - 3
For j = 1 To numofstocks
For i = 1 To numberofiterations
Sheets("NormData").Cells(i + 2, 2 * (j - 1) + 3).Value = (Sheets("NormData").Cells(i + 2, 2 * (j - 1) + 2).Value - Sheets("NormData").Cells(i + 3, 2 * (j - 1) + 2).Value) / Sheets("NormData").Cells(i + 3, 2 * (j - 1) + 2).Value
Next i
Next j
averageposition = Application.CountA(Sheets("NormData").Range("A:A")) + 2
For i = 1 To numofstocks
Worksheets("NormData").Cells(averageposition, 2 * (i - 1) + 2).Value = Worksheets("Static").Cells(i + 1, 1) & " average daily returns"
Worksheets("NormData").Cells(averageposition, 2 * (i - 1) + 3).Value = Application.WorksheetFunction.Average(Worksheets("NormData").Range(Cells(3, 2 * (i - 1) + 3), Cells(numberofiterations + 2, 2 * (i - 1) + 3)))
Worksheets("NormData").Cells(averageposition + 1, 2 * (i - 1) + 2).Value = Worksheets("Static").Cells(i + 1, 1) & " daily variance"
Worksheets("NormData").Cells(averageposition + 1, 2 * (i - 1) + 3).Value = Application.WorksheetFunction.VarP(Worksheets("NormData").Range(Cells(3, 2 * (i - 1) + 3), Cells(numberofiterations + 2, 2 * (i - 1) + 3)))
Worksheets("NormData").Cells(averageposition + 2, 2 * (i - 1) + 2).Value = Worksheets("Static").Cells(i + 1, 1) & " daily std dev"
Worksheets("NormData").Cells(averageposition + 2, 2 * (i - 1) + 3).Value = (Application.WorksheetFunction.VarP(Worksheets("NormData").Range(Cells(3, 2 * (i - 1) + 3), Cells(numberofiterations + 2, 2 * (i - 1) + 3)))) ^ (1 / 2)
Worksheets("NormData").Cells(averageposition + 3, 2 * (i - 1) + 2).Value = Worksheets("Static").Cells(i + 1, 1) & " 95% VaR"
Worksheets("NormData").Cells(averageposition + 3, 2 * (i - 1) + 3).Value = Application.WorksheetFunction.Percentile(Range(Cells(3, 2 * i + 1), Cells(numberofiterations + 2, 2 * i + 1)), 0.05)
Worksheets("NormData").Cells(averageposition + 4, 2 * (i - 1) + 2).Value = Worksheets("Static").Cells(i + 1, 1) & " 99% VaR"
Worksheets("NormData").Cells(averageposition + 4, 2 * (i - 1) + 3).Value = Application.WorksheetFunction.Percentile(Range(Cells(3, 2 * i + 1), Cells(numberofiterations + 2, 2 * i + 1)), 0.01)
Next i
For i = 1 To numofstocks
Worksheets("Static").Cells(1 + i, 4).Value = Worksheets("NormData").Cells(numberofiterations + 4, 2 * i + 1).Value
Next i
End Sub
For example, I am only able to run the code when I am in sheet "NormData", otherwise i get a run-time error '1004', application defined or object defined error. The code always stops in the second last for loop and highlights the second line of the loop. Thank you for your help in advance! Much appreciated :)

Your problem is that your code is using a bunch of unqualified/implicit references which innately makes it difficult to catch when one of these issues is code breaking. This line right here is the problem:
Worksheets("NormData").Range(Cells(3, 2 * (i - 1) + 3), Cells(numberofiterations + 2, 2 * (i - 1) + 3)))
See how you start with ActiveWorkbook.Worksheets("NormData").Range and then enter into an unqualified cells reference Cells(3, 2 * (i - 1) + 3)? This cells reference actually reads as ActiveSheet.Cells("") and so if your ActiveSheet is anything other than ActiveWorkbook.Worksheets("NormData") your code will break.
Check out this post for more info: Why does Range work, but not Cells? .

Try to set all worksheets in variables
For example:
dim wsNormData as Worksheet
set wsNormData = ThisWorkbook.Worksheets("NormData")
then use like:
wsNormData.Cells(x,y).value = "value"

Related

VBA: For-Loop should not stop when encountering an error, it should jump to the next block

I need to modify a for-loop, so that it skips to the next iteration when it does not find an object. Here is a snippet:
For j = 0 To i - 1
Proj = Cells(3 + j, 2).Value
ResClass = Cells(3 + j, 3).Value
Set project = resq.Projects.Item(Proj)
Set class = project.ReservingClasses(ResClass)
Set CFP = class.Vectors("Cashflow DFM JM").Method
Set CFPvol5 = class.Vectors("Cashflow DFM JM vol5").Method
Set CFPTr = class.Vectors("Cashflow DFM JM Tr").Method
orig = project.OriginCount
For k = 1 To orig
Cells(20 - 3, 4) = "DFM JM"
Cells(20 - 3, 4).Font.Bold = True
Cells(20 + k, col) = CFP.CashFlowPeriodLabel(k) - orig
Cells(20 - 2, col) = Cells(3 + j, 1).Value
Cells(20 - 2, col).Font.Bold = True
Cells(20 - 1, col + 1) = CFP.CashFlowPeriodLabel(1)
Cells(20 + k, col + 1) = Round(CFP.DiscountedCashflows(k, 1), 0)
Cells(20 - 1, col + 2) = CFP.CashFlowPeriodLabel(2)
Cells(20 + k, col + 2) = Round(CFP.DiscountedCashflows(k, 2), 0)
Cells(59 - 3, 4) = "DFM Paid vol5"
Cells(59 - 3, 4).Font.Bold = True
Cells(59 + k, col) = CFPvol5.CashFlowPeriodLabel(k) - orig
Cells(59 - 2, col) = Cells(3 + j, 1).Value
Cells(59 - 2, col).Font.Bold = True
Cells(59 - 1, col + 1) = CFPvol5.CashFlowPeriodLabel(1)
Cells(59 + k, col + 1) = Round(CFPvol5.DiscountedCashflows(k, 1), 0)
Cells(59 - 1, col + 2) = CFPvol5.CashFlowPeriodLabel(2)
Cells(59 + k, col + 2) = Round(CFPvol5.DiscountedCashflows(k, 2), 0)
Cells(98 - 3, 4) = "DFM JM Tr"
Cells(98 - 3, 4).Font.Bold = True
Cells(98 + k, col) = CFPTr.CashFlowPeriodLabel(k) - orig
Cells(98 - 2, col) = Cells(3 + j, 1).Value
Cells(98 - 2, col).Font.Bold = True
Cells(98 - 1, col + 1) = CFPTr.CashFlowPeriodLabel(1)
Cells(98 + k, col + 1) = Round(CFPTr.DiscountedCashflows(k, 1), 0)
Cells(98 - 1, col + 2) = CFPTr.CashFlowPeriodLabel(2)
Cells(98 + k, col + 2) = Round(CFPTr.DiscountedCashflows(k, 2), 0)
Next k
col = col + 4
Next
If for a certain j in the first for-loop there is no CFPvol5 in the second for-loop, then the procedure stops with an error. I want the procedure to continue with the next block, in this case with CFPTr. Is this possible? And if yes, how?
Thank you very much for your help!
Shown 2 methods: Just a sample.
on error resume next
For i = 1 to x
'do your stuff here
next
on error goto 0
or
on error goto nextLoop
for i = 1 to x
' do your stuff here
nextLoop:
next

"Overflow" Error (6) when doing calculations on arrays

I am creating a macro in VBA which finds values in one sheet and uses them to populate array MyArr(11,4) and then does calculation. Find and populating part works great, problem is the latter part.
.Range("C2").Value = MyArr(11, 4) / MyArr(11, 1)
.Range("D2").Value = (MyArr(9, 4) + MyArr(10, 4) + MyArr(11, 4)) / (MyArr(9, 1) + MyArr(10, 1) + MyArr(11, 1))
.Range("E2").Value = (MyArr(0, 4) + MyArr(1, 4) + MyArr(2, 4) + MyArr(3, 4) + MyArr(4, 4) + MyArr(5, 4) + MyArr(6, 4) + MyArr(7, 4) + MyArr(8, 4) + MyArr(9, 4) + MyArr(10, 4) + MyArr(11, 4)) / (MyArr(0, 1) + MyArr(1, 1) + MyArr(2, 1) + MyArr(3, 1) + MyArr(4, 1) + MyArr(5, 1) + MyArr(6, 1) + MyArr(7, 1) + MyArr(8, 1) + MyArr(9, 1) + MyArr(10, 1) + MyArr(11, 1))
This is the fragment of code in question. It causes Overflow error (6). I know this error happens due to one of the values in array being empty. Is there an easy way to stop using empty values but still execute the code for the filled ones? So if for example MyArr(9,4) is empty it would still execute the 2nd line of code because there are values in (10, 4), (11, 4) with omitting (9,4).
If the rest of the code is needed please inform me.
As #Jon mentioned, check for division by zero before doing the division:
If MyArr(11, 1) <> 0 Then
.Range("C2").Value = MyArr(11, 4) / MyArr(11, 1)
Else
.Range("C2").Value = 0
End If
If (MyArr(9, 1) + MyArr(10, 1) + MyArr(11, 1)) <> 0 Then
.Range("D2").Value = (MyArr(9, 4) + MyArr(10, 4) + MyArr(11, 4)) / (MyArr(9, 1) + MyArr(10, 1) + MyArr(11, 1))
Else
.Range("D2").Value = 0
End If
If (MyArr(0, 1) + MyArr(1, 1) + MyArr(2, 1) + MyArr(3, 1) + MyArr(4, 1) + MyArr(5, 1) + MyArr(6, 1) + MyArr(7, 1) + MyArr(8, 1) + MyArr(9, 1) + MyArr(10, 1) + MyArr(11, 1)) <> 0 Then
.Range("E2").Value = (MyArr(0, 4) + MyArr(1, 4) + MyArr(2, 4) + MyArr(3, 4) + MyArr(4, 4) + MyArr(5, 4) + MyArr(6, 4) + MyArr(7, 4) + MyArr(8, 4) + MyArr(9, 4) + MyArr(10, 4) + MyArr(11, 4)) / (MyArr(0, 1) + MyArr(1, 1) + MyArr(2, 1) + MyArr(3, 1) + MyArr(4, 1) + MyArr(5, 1) + MyArr(6, 1) + MyArr(7, 1) + MyArr(8, 1) + MyArr(9, 1) + MyArr(10, 1) + MyArr(11, 1))
Else
.Range("E2").Value = 0
End If

Loop with Lbounds and Ubounds?

My LastRowsht variable count the last row of the worksheet.
If the LastRowsht + 1 = 2 (second row in Excel) there is nothing on the cell.
After this my code divide a cell by another one but the denominator needs to change depending on the LastRowsht + 1.
My lowerbound and upperbound needs to increment by 12 each time and same with the denominator.
The probleme is there is no end of upperbound ( i have to do it until the end of worksheet) so i can't figure out how i can do this.
Can you help me make this loop ? Thank you.
Here is my code :
If LastRowsht + 1 = 2 Then
sht.Cells(LastRowsht + 1, 17) = ""
Else
If 2 < LastRowsht + 1 < 15 Then
sht.Cells(LastRowsht + 1, 17) = (sht.Cells(LastRowsht + 1, 7) / sht.Cells(2, 7)) - 1
Else
If 14 < LastRowsht + 1 < 27 Then
sht.Cells(LastRowsht + 1, 17) = (sht.Cells(LastRowsht + 1, 7) / sht.Cells(14, 7)) - 1
Else
If 26 < LastRowsht + 1 < 39 Then
sht.Cells(LastRowsht + 1, 17) = (sht.Cells(LastRowsht + 1, 7) / sht.Cells(26, 7)) - 1
Else
If 38 < LastRowsht + 1 < 51 Then
sht.Cells(LastRowsht + 1, 17) = (sht.Cells(LastRowsht + 1, 7) / sht.Cells(38, 7)) - 1
End If
All you need to do is put this:
If LastRowsht + 1 = 2 Then
sht.Cells(LastRowsht + 1, 17) = ""
Else
sht.Cells(LastRowsht + 1, 17) = (sht.Cells(LastRowsht + 1, 7) / sht.Cells((2 + ((LastRowsht + 1 - 3) \ 12) * 12), 7)) - 1
End If
Note that "\" is the integer division operator.

VBA List to be put in sticker format

I have a list of data which needs to be printed out on stickers (imagine the Avery kind). I'm having trouble coming up with the code that will produce the desired result:
My code thus far is:
With wsEtiketten
' erase old data
.Cells.Clear
' enter new data
With .Cells(1, 2)
.Value = "Lettrine"
.Font.Bold = True
End With
.Cells(2, 2).Value = sAuswertungsLettrine
For i = 0 To MaxRow - 1
For j = 0 To 4
r.Copy .Cells(4, 2).Offset(i * 5, j * 5)
.Cells(4, 2).Offset((i * 5) + 1, (j * 5) + 0) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 1).Value 'Page
.Cells(4, 2).Offset((i * 5) + 1, (j * 5) + 1) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 2).Value 'Ordernr
.Cells(4, 2).Offset((i * 5) + 1, (j * 5) + 2) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 8).Value 'Surf
.Cells(4, 2).Offset((i * 5) + 1, (j * 5) + 3) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 9).Value 'Indice DB
.Cells(4, 2).Offset((i * 5) + 3, (j * 5) + 0) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 3).Value 'Count
.Cells(4, 2).Offset((i * 5) + 3, (j * 5) + 1) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 4).Value 'CA Brut
.Cells(4, 2).Offset((i * 5) + 3, (j * 5) + 3) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 7).Value 'Marge
Next j
Next i
End With
The information which is tied to it is simply repeated across the row. I need i to change every time the field is offset. How can I do that? I'm sure this is probably programming kindergarden stuff but I'm not getting it.
Thanks!
Maybe an answer with an unexpected twist. You can use an Excel table in combination with Word to get the result you want as well. This is standard Office functionality:
http://support.microsoft.com/kb/318117/en
or in German:
http://support.microsoft.com/kb/318117/de
Ok. I managed to come up with an answer within Excel. Once I had it, it was obvious.
Here goes:
With wsEtiketten
' Alte Daten werden gelöscht
.Cells.Clear
' Neue Daten werden eingelesen
With .Cells(1, 2)
.Value = "Lettrine"
.Font.Bold = True
End With
.Cells(2, 2).Value = sAuswertungsLettrine
For i = 0 To MaxRow - 1
r.Copy .Cells(4, 2).Offset(WorksheetFunction.RoundDown(i / 5, 0) * 5, ((i + 5) Mod 5) * 5)
.Cells(4, 2).Offset((WorksheetFunction.RoundDown(i / 5, 0)) * 5 + 1, ((i + 5) Mod 5) * 5 + 0) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 1).Value 'Page
.Cells(4, 2).Offset((WorksheetFunction.RoundDown(i / 5, 0)) * 5 + 1, ((i + 5) Mod 5) * 5 + 1) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 2).Value 'Bestellnummer
.Cells(4, 2).Offset((WorksheetFunction.RoundDown(i / 5, 0)) * 5 + 1, ((i + 5) Mod 5) * 5 + 2) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 8).Value 'Surf
.Cells(4, 2).Offset((WorksheetFunction.RoundDown(i / 5, 0)) * 5 + 1, ((i + 5) Mod 5) * 5 + 3) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 9).Value 'Indice DB
.Cells(4, 2).Offset((WorksheetFunction.RoundDown(i / 5, 0)) * 5 + 3, ((i + 5) Mod 5) * 5 + 0) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 3).Value 'Anzahl
.Cells(4, 2).Offset((WorksheetFunction.RoundDown(i / 5, 0)) * 5 + 3, ((i + 5) Mod 5) * 5 + 1) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 4).Value 'CA Brut
.Cells(4, 2).Offset((WorksheetFunction.RoundDown(i / 5, 0)) * 5 + 3, ((i + 5) Mod 5) * 5 + 3) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 7).Value 'Marge
Next i
End With

Issue with logic when looping in vba

I've created a particularly long vba macro to edit a large spreadsheet of data for me instead of doing it myself thousands of times. The code for the actual editing works fine, however, when I add in the first if statements and first while loop to make it loop through the whole spreadsheet, I get a runtime error 1004. I'm new to vba but I'm pretty sure there is an error in my logic rather than the code itself. I've marked which lines of code cause the error when added.
Sub RCFS()
Dim ProfCtr As String
Dim Year As String
Dim Amount As Currency
Dim Period As Long
Dim S2FreecellH As Long
Dim ProfCenCellH As Long
Dim FreeCellClone As Long
Dim Clone2 As Long
Dim Clone3 As Long
Dim y As Long ' placeholder 2
y = 1
S2FreecellH = 3
ProfCenCellH = 2
AmountH = 2
PeriodH = 2
YearH = 2
ProfCtr = Cells(ProfCenCellH, 4)
Year = Cells(YearH, 7)
Amount = Cells(AmountH, 8)
Period = Cells(PeriodH, 6)
'//////////////////////////////////////////////////////////////////////////////////
While IsEmpty(Cells(ProfCenCell, 4).Value) = False
Everything fine until this while loop (above) and if statement (below). The rest works fine without these 2 statements but I need it to loop through the whole spreadsheet.
If Cells(ProfCenCell, 4).Value = Worksheets("Sheet2").Cells(S2FreecellH, 1).Value Then
Worksheets("Sheet2").Cells(S2FreecellH, 1).Value = ProfCtr
Worksheets("Sheet2").Cells(S2FreecellH, 5).Value = ProfCtr
Worksheets("Sheet2").Cells(S2FreecellH, 9).Value = ProfCtr
FreeCellClone = S2FreecellH 'setting clones
Clone2 = S2FreecellH
Clone3 = S2FreecellH
For x = S2FreecellH + 1 To S2FreecellH + 12
Worksheets("Sheet2").Cells(x, 2).Value = y 'Creating 1 to 12 numbering in column 1
Worksheets("Sheet2").Cells(x, 6).Value = y 'Creating 1 to 12 numbering in column 2
Worksheets("Sheet2").Cells(x, 10).Value = y 'Creating 1 to 12 numbering in column 3
S2FreecellH = S2FreecellH + 1
y = y + 1
Next x
While Worksheets("Sheet2").Cells(FreeCellClone, 1).Value = Cells(YearH, 4).Value 'Loop to input all amounts
Worksheets("Sheet2").Cells(FreeCellClone + Period, (((Year Mod 11) * 4)) - 1).Value = Amount 'Calculation on post year to select correct column to post amount in
PeriodH = PeriodH + 1
AmountH = AmountH + 1
YearH = YearH + 1
Year = Cells(YearH, 7)
Amount = Cells(AmountH, 8)
Period = Cells(PeriodH, 6)
Wend
Worksheets("Sheet2").Cells(S2FreecellH + 1, 3) = WorksheetFunction.Sum(Worksheets("Sheet2").Range(Worksheets("Sheet2").Cells(FreeCellClone + 1, 3), Worksheets("Sheet2").Cells(S2FreecellH, 3)))
Worksheets("Sheet2").Cells(S2FreecellH + 1, 7) = WorksheetFunction.Sum(Worksheets("Sheet2").Range(Worksheets("Sheet2").Cells(FreeCellClone + 1, 7), Worksheets("Sheet2").Cells(S2FreecellH, 7))) 'Creating sums for all 3 columns
Worksheets("Sheet2").Cells(S2FreecellH + 1, 11) = WorksheetFunction.Sum(Worksheets("Sheet2").Range(Worksheets("Sheet2").Cells(FreeCellClone + 1, 11), Worksheets("Sheet2").Cells(S2FreecellH, 11)))
For Z = Clone2 + 1 To Clone2 + 12 'creating intitial percentage values
Worksheets("Sheet2").Cells(Z, 4).Value = Format((Worksheets("Sheet2").Cells(Z, 3) / Worksheets("Sheet2").Cells(S2FreecellH + 1, 3)) * 100, "%0.00")
Worksheets("Sheet2").Cells(Z, 8).Value = Format((Worksheets("Sheet2").Cells(Z, 7) / Worksheets("Sheet2").Cells(S2FreecellH + 1, 7)) * 100, "%0.00")
Worksheets("Sheet2").Cells(Z, 12).Value = Format((Worksheets("Sheet2").Cells(Z, 11) / Worksheets("Sheet2").Cells(S2FreecellH + 1, 11)) * 100, "%0.00")
Next
For q = Clone3 + 1 To Clone3 + 12 'creating final percentage values
Worksheets("Sheet2").Cells(q, 13).Value = Format(((Worksheets("Sheet2").Cells(q, 4) + Worksheets("Sheet2").Cells(q, 8) + Worksheets("Sheet2").Cells(q, 12)) / 3) * 100, "%0.00")
Next q
Worksheets("Sheet2").Cells(S2FreecellH + 1, 13) = WorksheetFunction.Sum(Worksheets("Sheet2").Range(Worksheets("Sheet2").Cells(FreeCellClone + 1, 13), Worksheets("Sheet2").Cells(S2FreecellH, 13)))
Else
ProfCenCell = ProfCenCell + 1
End If
'/////////////////////////////////////////////////////////////////////////////// Loop these Loops
S2FreecellH = S2FreecellH + 3
y = 1
Wend
End Sub
You never set a value for ProfCenCell, hence it has default value 0. Then, you use Cells(ProfCenCell, 4) which is in your case Cells(0, 4) and that 0 makes a problem.