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.
Related
I am currently coding in VBA and have run into an issue.
I have created a button that calls in a number of subroutines. It runs perfectly until it reaches a subroutine that uses a function. When I run the sub in the developer tab, it runs fine; however, when I call the subroutine using a button I get this error:
"Compile Error:
Method or data member not found."
Do you know how to fix this?
Below is the subroutine and function being used:
Sub DiscountRate()
'Set Dimensions
Dim ws As Worksheet
Dim i As Integer
Dim Counter As Integer
Dim Value As Integer
Dim tempcount As Double
'Set parameters
Set SummarySheet = Sheets("Summary & Inputs")
Set ExpectedCompSheet = Sheets("Expected Compensation")
Set WorkYears = SummarySheet.Range("C40")
Set DiscountSheet = Sheets("Treasury Rates")
Set DiscountRateRange = DiscountSheet.Range("B7:L7")
'Clear column
ExpectedCompSheet.Range("H13:I113").Clear
'Clear color
ExpectedCompSheet.Range("H13:I113").Interior.Color = xlNone
'If prejudgment interest is filled, count and fill discount rate cells
i = 1
For Counter = 1 To WorkYears
If IsEmpty(ExpectedCompSheet.Cells(12 + Counter, 7)) = False Then
ExpectedCompSheet.Cells(12 + Counter, 8).Interior.ColorIndex = 16
ExpectedCompSheet.Cells(12 + Counter, 9).Interior.ColorIndex = 16
i = i + 1
End If
Next Counter
'Create increasing range to sum fractions of years
IncreasingRange = ExpectedCompSheet.Range(ExpectedCompSheet.Cells(12 + i, 5), _
ExpectedCompSheet.Cells(11 + i + Counter, 5))
'Find discount rate associated with increasing years
For Counter = 1 To (WorkYears + 2 - i)
IncreasingRange = ExpectedCompSheet.Range(ExpectedCompSheet.Cells(12 + i, 5), _
ExpectedCompSheet.Cells(11 + i + Counter, 5))
tempcount = Application.WorksheetFunction.Sum(IncreasingRange)
ExpectedCompSheet.Cells(11 + i + Counter, 8) = getclosest(DiscountRateRange, tempcount)
Next Counter
For Counter = 1 To (WorkYears + 2 - i)
If ExpectedCompSheet.Cells(11 + i + Counter, 8) = 0.08 Then
ExpectedCompSheet.Cells(11 + i + Counter, 8) = "1 Month"
ExpectedCompSheet.Cells(11 + i + Counter, 9) = DiscountSheet.Range("B9") / 100
ElseIf ExpectedCompSheet.Cells(11 + i + Counter, 8) = 0.25 Then
ExpectedCompSheet.Cells(11 + i + Counter, 8) = "3 Month"
ExpectedCompSheet.Cells(11 + i + Counter, 9) = DiscountSheet.Range("C9") / 100
ElseIf ExpectedCompSheet.Cells(11 + i + Counter, 8) = 0.5 Then
ExpectedCompSheet.Cells(11 + i + Counter, 8) = "6 Month"
ExpectedCompSheet.Cells(11 + i + Counter, 9) = DiscountSheet.Range("D9") / 100
ElseIf ExpectedCompSheet.Cells(11 + i + Counter, 8) = 1 Then
ExpectedCompSheet.Cells(11 + i + Counter, 8) = "1 Year"
ExpectedCompSheet.Cells(11 + i + Counter, 9) = DiscountSheet.Range("E9") / 100
ElseIf ExpectedCompSheet.Cells(11 + i + Counter, 8) = 2 Then
ExpectedCompSheet.Cells(11 + i + Counter, 8) = "2 Year"
ExpectedCompSheet.Cells(11 + i + Counter, 9) = DiscountSheet.Range("F9") / 100
ElseIf ExpectedCompSheet.Cells(11 + i + Counter, 8) = 3 Then
ExpectedCompSheet.Cells(11 + i + Counter, 8) = "3 Year"
ExpectedCompSheet.Cells(11 + i + Counter, 9) = DiscountSheet.Range("G9") / 100
ElseIf ExpectedCompSheet.Cells(11 + i + Counter, 8) = 5 Then
ExpectedCompSheet.Cells(11 + i + Counter, 8) = "5 Year"
ExpectedCompSheet.Cells(11 + i + Counter, 9) = DiscountSheet.Range("H9") / 100
ElseIf ExpectedCompSheet.Cells(11 + i + Counter, 8) = 7 Then
ExpectedCompSheet.Cells(11 + i + Counter, 8) = "7 Year"
ExpectedCompSheet.Cells(11 + i + Counter, 9) = DiscountSheet.Range("I9") / 100
ElseIf ExpectedCompSheet.Cells(11 + i + Counter, 8) = 10 Then
ExpectedCompSheet.Cells(11 + i + Counter, 8) = "10 Year"
ExpectedCompSheet.Cells(11 + i + Counter, 9) = DiscountSheet.Range("J9") / 100
ElseIf ExpectedCompSheet.Cells(11 + i + Counter, 8) = 20 Then
ExpectedCompSheet.Cells(11 + i + Counter, 8) = "20 Year"
ExpectedCompSheet.Cells(11 + i + Counter, 9) = DiscountSheet.Range("K9") / 100
ElseIf ExpectedCompSheet.Cells(11 + i + Counter, 8) = 30 Then
ExpectedCompSheet.Cells(11 + i + Counter, 8) = "30 Year"
ExpectedCompSheet.Cells(11 + i + Counter, 9) = DiscountSheet.Range("L9") / 100
End If
Next Counter
End Sub
Function getclosest(ByVal rng As Range, tgt As Double) As Double
t = WorksheetFunction.Max(rng)
For Each r In rng
u = Abs(r - tgt)
If u < t Then
t = u
getclosest = r
End If
Next
End Function
I am using a button with code:
Sub CalculateExpectedComp()
Call Module1.ExpectedCompYear
Call Module1.ExpectedCompPeriod
Call Module1.ExpectedCompAge
Call Module1.ExpectedCompPaymentAnnual
Call Module1.ExpectedCompYearFrac
Call Module1.ExpectedCompPartialYearComp
Call Module1.PrejudgmentInterest
Call Module1.DiscountRate
Call Module1.PresentValueFactor
Call Module1.PV
Call Module1.CumulativeValue
Call Module1.Formatting
End Sub
The issue occurs when "Call Module1.DiscountRate" runs.
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
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"
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
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.