VBA - assinging values through for loop - excel

Is there a more efficient way of handling the below?
Range("approvedSales").Cells(raS, 2).Value = Sheet1.Cells(i, 1).Value
Range("approvedSales").Cells(raS, 3).Value = Sheet1.Cells(i, 4).Value
Range("approvedSales").Cells(raS, 4).Value = Sheet1.Cells(i, 6).Value
Range("approvedSales").Cells(raS, 5).Value = Sheet1.Cells(i, 7).Value
Range("approvedSales").Cells(raS, 6).Value = Sheet1.Cells(i, 9).Value
Range("approvedSales").Cells(raS, 7).Value = Sheet1.Cells(i, 26).Value
Range("approvedSales").Cells(raS, 8).Value = Sheet1.Cells(i, 27).Value
Range("approvedSales").Cells(raS, 9).Value = Sheet1.Cells(i, 16).Value
Range("approvedSales").Cells(raS, 10).Value = Sheet1.Cells(i, 17).Value
Range("approvedSales").Cells(raS, 11).Value = Sheet1.Cells(i, 18).Value
Range("approvedSales").Cells(raS, 12).Value = Sheet1.Cells(i, 19).Value
raS = raS + 1


The "cleaner" way to do this is to store your values in Arrays instead:
Dim array1() As Variant, array2() As Variant, i As Integer
array1 = Array(2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)
array2 = Array(1, 4, 6, 7, 9, 26, 27, 16, 17, 18, 19)
For i = 0 To 10
Range("approvedSales").Cells(raS, array1(i)).Value = Sheet1.Cells(i, array2(i)).Value
Next i

Related

Loop to copy values from one sheet to another

I have 2 sheets, sourcesheet and acct sheet. From sourceSheet I need to copy the values from sourceSheet.Range(Cells(14, 3),Cells(14, 8)) to AcctSheet.range(Cells(2, 11),Cells(7, 11)), however each cell from sourcesheet is distinct matched to acctsheet, in such a way that
sourceSheet.Cells(14, 3) = AcctSheet.Cells(2, 11)
sourceSheet.Cells(14, 4) = AcctSheet.Cells(3, 11)
sourceSheet.Cells(14, 5) = AcctSheet.Cells(4, 11) and so on until
sourceSheet.Cells(14, 8) = AcctSheet.Cells(7, 11)
Code is here, but hoping to loop this one.
sourceSheet.Activate
'EQ
If IsEmpty(sourceSheet.Cells(14, 3).Value) Then
AcctSheet.Cells(2, 11).Value = sourceSheet.Cells(7, 1).Value
ElseIf sourceSheet.Cells(14, 3).Value < sourceSheet.Cells(7, 1).Value Then
AcctSheet.Cells(2, 11).Value = sourceSheet.Cells(14, 3).Value
ElseIf sourceSheet.Cells(14, 3).Value > sourceSheet.Cells(7, 1).Value Then
AcctSheet.Cells(2, 11).Value = sourceSheet.Cells(7, 1).Value
End If
'WS
If IsEmpty(sourceSheet.Cells(14, 4).Value) Then
AcctSheet.Cells(3, 11).Value = sourceSheet.Cells(7, 1).Value
ElseIf sourceSheet.Cells(14, 4).Value < sourceSheet.Cells(7, 1).Value Then
AcctSheet.Cells(3, 11).Value = sourceSheet.Cells(14, 4).Value
ElseIf sourceSheet.Cells(14, 4).Value > sourceSheet.Cells(7, 1).Value Then
AcctSheet.Cells(3, 11).Value = sourceSheet.Cells(7, 1).Value
End If
'TO
If IsEmpty(sourceSheet.Cells(14, 5).Value) Then
AcctSheet.Cells(4, 11).Value = sourceSheet.Cells(7, 1).Value
ElseIf sourceSheet.Cells(14, 5).Value < sourceSheet.Cells(7, 1).Value Then
AcctSheet.Cells(4, 11).Value = sourceSheet.Cells(14, 5).Value
ElseIf sourceSheet.Cells(14, 5).Value > sourceSheet.Cells(7, 1).Value Then
AcctSheet.Cells(4, 11).Value = sourceSheet.Cells(7, 1).Value
End If
'FL
If IsEmpty(sourceSheet.Cells(14, 6).Value) Then
AcctSheet.Cells(5, 11).Value = sourceSheet.Cells(7, 1).Value
ElseIf sourceSheet.Cells(14, 6).Value < sourceSheet.Cells(7, 1).Value Then
AcctSheet.Cells(5, 11).Value = sourceSheet.Cells(14, 6).Value
ElseIf sourceSheet.Cells(14, 6).Value > sourceSheet.Cells(7, 1).Value Then
AcctSheet.Cells(5, 11).Value = sourceSheet.Cells(7, 1).Value
End If
'FR
If IsEmpty(sourceSheet.Cells(14, 7).Value) Then
AcctSheet.Cells(6, 11).Value = sourceSheet.Cells(7, 1).Value
ElseIf sourceSheet.Cells(14, 7).Value < sourceSheet.Cells(7, 1).Value Then
AcctSheet.Cells(6, 11).Value = sourceSheet.Cells(14, 7).Value
ElseIf sourceSheet.Cells(14, 7).Value > sourceSheet.Cells(7, 1).Value Then
AcctSheet.Cells(6, 11).Value = sourceSheet.Cells(7, 1).Value
End If
'TR
If IsEmpty(sourceSheet.Cells(14, 8).Value) Then
AcctSheet.Cells(7, 11).Value = sourceSheet.Cells(7, 1).Value
ElseIf sourceSheet.Cells(14, 8).Value < sourceSheet.Cells(7, 1).Value Then
AcctSheet.Cells(7, 11).Value = sourceSheet.Cells(14, 8).Value
ElseIf sourceSheet.Cells(14, 8).Value > sourceSheet.Cells(7, 1).Value Then
AcctSheet.Cells(7, 11).Value = sourceSheet.Cells(7, 1).Value
End If

Is something like this what you are looking for?
Option Explicit
Sub test()
Dim sourceSheet As Worksheet, acctSheet As Worksheet
Dim i As Long
Dim sourceCell As Range, targetCell As Range, defaultCell As Range
Set defaultCell = sourceSheet.Cells(7, 1)
For i = 3 To 8
Set sourceCell = sourceSheet.Cells(14, i)
Set targetCell = acctSheet.Cells(i - 1, 11)
If IsEmpty(sourceCell) Then
targetCell.Value2 = sourceCell.Value2
ElseIf sourceCell.Value2 < defaultCell.Value2 Then
targetCell.Value2 = sourceCell.Value2
ElseIf sourceCell.Value2 > defaultCell.Value2 Then
targetCell.Value2 = defaultCell.Value2
End If
Next i
End Sub
Strictly speaking, I don't think you need to include .Value2 after every cell, as VBA kinda uses that as the default when reading the code, but it doesn't hurt.
Using variables for the cell references isn't strictly necessary either, but I find it easier, especially if I need to edit the cell references later.

Populate listbox with headers

I am trying to populate a listbox from a list of items, I can get it to populate but it is taking in my header row as a row in the list and the headers are blank. I am not sure where I am going wrong. Any help would be great.
Sub populateList()
Dim rngName As Range
Dim ws As Worksheet
Dim i As Integer
Set ws = Worksheets("ProjectData")
lbTasks.Clear
lbTasks.ColumnHeads = True
lbTasks.ColumnCount = 10
Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
For i = 1 To LastRow
If ws.Cells(i, 1).Value <> vbNullString Then lbTasks.AddItem ws.Cells(i, 1).Value
If ws.Cells(i, 2).Value <> vbNullString Then lbTasks.List(i - 1, 1) = ws.Cells(i, 2).Value
If ws.Cells(i, 3).Value <> vbNullString Then lbTasks.List(i - 1, 2) = ws.Cells(i, 3).Value
If ws.Cells(i, 4).Value <> vbNullString Then lbTasks.List(i - 1, 3) = ws.Cells(i, 4).Value
If ws.Cells(i, 5).Value <> vbNullString Then lbTasks.List(i - 1, 4) = ws.Cells(i, 5).Value
If ws.Cells(i, 6).Value <> vbNullString Then lbTasks.List(i - 1, 5) = ws.Cells(i, 6).Value
If ws.Cells(i, 7).Value <> vbNullString Then lbTasks.List(i - 1, 6) = ws.Cells(i, 7).Value
If ws.Cells(i, 8).Value <> vbNullString Then lbTasks.List(i - 1, 7) = ws.Cells(i, 8).Value
If ws.Cells(i, 9).Value <> vbNullString Then lbTasks.List(i - 1, 8) = ws.Cells(i, 9).Value
If ws.Cells(i, 10).Value <> vbNullString Then lbTasks.List(i - 1, 9) = ws.Cells(i, 10).Value
Next i
End Sub

Elegant way of shortening this code using a loops

In need of some help. I am copying data from a table to specific places in another and transposing it. I know there is a faster way of doing this with a loop but for the life of me i cant figure it out.
If you look at the code the only thing changing is the column number of "Daily Dotcom" (3,4,5 then 7,8,9 then 11,12,13 etc) and the Row number of "dotFigures" (2,3,4 then 7,8,9 then 12,13,14 etc)
After thats been done, I need to do exactly the same but with 2 other tables called "dailySeasonal" and "dailyManual" using arrays called "seaFigures" and "manFigures"
So you can see why im so desperate to shorten the code, as it will get ridiculously long winded.
For i = 1 To ActiveSheet.ListObjects("dailyDotcom").ListRows.Count
If ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i, 1).Value = wkComm Then
'planned FTAM
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i, 3).Value = dotFigures(2, 2)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 1, 3).Value = dotFigures(2, 3)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 2, 3).Value = dotFigures(2, 4)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 3, 3).Value = dotFigures(2, 5)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 4, 3).Value = dotFigures(2, 6)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 5, 3).Value = dotFigures(2, 7)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 6, 3).Value = dotFigures(2, 8)
'attended FTAM
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i, 4).Value = dotFigures(3, 2)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 1, 4).Value = dotFigures(3, 3)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 2, 4).Value = dotFigures(3, 4)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 3, 4).Value = dotFigures(3, 5)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 4, 4).Value = dotFigures(3, 6)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 5, 4).Value = dotFigures(3, 7)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 6, 4).Value = dotFigures(3, 8)
'absence FTAM
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i, 5).Value = dotFigures(4, 2)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 1, 5).Value = dotFigures(4, 3)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 2, 5).Value = dotFigures(4, 4)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 3, 5).Value = dotFigures(4, 5)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 4, 5).Value = dotFigures(4, 6)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 5, 5).Value = dotFigures(4, 7)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 6, 5).Value = dotFigures(4, 8)
'planned FTPM
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i, 7).Value = dotFigures(7, 2)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 1, 7).Value = dotFigures(7, 3)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 2, 7).Value = dotFigures(7, 4)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 3, 7).Value = dotFigures(7, 5)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 4, 7).Value = dotFigures(7, 6)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 5, 7).Value = dotFigures(7, 7)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 6, 7).Value = dotFigures(7, 8)
'attended FTPM
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i, 8).Value = dotFigures(8, 2)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 1, 8).Value = dotFigures(8, 3)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 2, 8).Value = dotFigures(8, 4)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 3, 8).Value = dotFigures(8, 5)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 4, 8).Value = dotFigures(8, 6)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 5, 8).Value = dotFigures(8, 7)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 6, 8).Value = dotFigures(8, 8)
'absence FTPM
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i, 9).Value = dotFigures(9, 2)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 1, 9).Value = dotFigures(9, 3)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 2, 9).Value = dotFigures(9, 4)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 3, 9).Value = dotFigures(9, 5)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 4, 9).Value = dotFigures(9, 6)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 5, 9).Value = dotFigures(9, 7)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 6, 9).Value = dotFigures(9, 8)
'planned Nights
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i, 11).Value = dotFigures(12, 2)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 1, 11).Value = dotFigures(12, 3)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 2, 11).Value = dotFigures(12, 4)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 3, 11).Value = dotFigures(12, 5)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 4, 11).Value = dotFigures(12, 6)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 5, 11).Value = dotFigures(12, 7)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 6, 11).Value = dotFigures(12, 8)
'attended Nights
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i, 12).Value = dotFigures(13, 2)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 1, 12).Value = dotFigures(13, 3)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 2, 12).Value = dotFigures(13, 4)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 3, 12).Value = dotFigures(13, 5)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 4, 12).Value = dotFigures(13, 6)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 5, 12).Value = dotFigures(13, 7)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 6, 12).Value = dotFigures(13, 8)
'absence Nights
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i, 13).Value = dotFigures(14, 2)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 1, 13).Value = dotFigures(14, 3)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 2, 13).Value = dotFigures(14, 4)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 3, 13).Value = dotFigures(14, 5)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 4, 13).Value = dotFigures(14, 6)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 5, 13).Value = dotFigures(14, 7)
ActiveSheet.ListObjects("dailyDotcom").DataBodyRange(i + 6, 13).Value = dotFigures(14, 8)
End If
Next i
Any help would be much appreciated!

Use a With statement to shorten these long lines.
Use Option Explicit and declare all your variables.
Use a second loop j to count the other steps from 0 to 6
So you end up with:
Option Explicit
Public Sub DoMyStuff()
With ActiveSheet.ListObjects("dailyDotcom")
Dim i As Long, j As Long
For i = 1 To .ListRows.Count
If .DataBodyRange(i, 1).Value = wkComm Then
For j = 0 To 6
.DataBodyRange(i + j, 3).Value = dotFigures(2, 2 + j) 'planned FTAM
.DataBodyRange(i + j, 4).Value = dotFigures(3, 2 + j) 'attended FTAM
.DataBodyRange(i + j, 5).Value = dotFigures(4, 2 + j) 'absence FTAM
.DataBodyRange(i + j, 7).Value = dotFigures(7, 2 + j) 'planned FTPM
.DataBodyRange(i + j, 8).Value = dotFigures(8, 2 + j) 'attended FTPM
.DataBodyRange(i + j, 9).Value = dotFigures(9, 2 + j) 'absence FTPM
.DataBodyRange(i + j, 11).Value = dotFigures(12, 2 + j) 'planned Nights
.DataBodyRange(i + j, 12).Value = dotFigures(13, 2 + j) 'attended Nights
.DataBodyRange(i + j, 13).Value = dotFigures(14, 2 + j) 'absence Nights
Next j
End If
Next i
End With
End Sub

dynamic with loop for i to n, adds rows but does not cover full range

I have a macro, that start from i, and ends at n. n is the end of the dynamic range. The macro adds rows and enters data based on various criterias. The code works very fine, but it only covers 85% of the total range before 'n' ends.
see code below:
Sub AddExtrasFerry()
Dim i As Long
Dim n As Long
n = Sheets("Original").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("Original").Select
For i = 10 To n
If Cells(i, 16).Value <> "" And Cells(i, 3).Value Like "Wood*" And Cells(i, 16).Value = 100 Then
Cells(i + 1, 16).EntireRow.Insert
Cells(i + 1, 1).EntireRow.Value = Cells(i, 1).EntireRow.Value
Cells(i + 1, 6).Value = 100
Cells(i + 1, 1).Value = 20430
Cells(i + 1, 11).Value = ""
Cells(i + 1, 12).Value = ""
Cells(i + 1, 15).Value = ""
Cells(i + 1, 16).Value = ""
ElseIf Cells(i, 16).Value <> "" And Cells(i, 3).Value Like "Wood*" And Cells(i, 16).Value > 100 Then
Cells(i + 1, 16).EntireRow.Insert
Cells(i + 1, 1).EntireRow.Value = Cells(i, 1).EntireRow.Value
Cells(i + 1, 6).Value = 100
Cells(i + 1, 1).Value = 20430
Cells(i + 1, 11).Value = ""
Cells(i + 1, 12).Value = ""
Cells(i + 1, 15).Value = ""
Cells(i + 1, 16).Value = ""
Cells(i + 2, 16).EntireRow.Insert
Cells(i + 2, 1).EntireRow.Value = Cells(i, 1).EntireRow.Value
Cells(i + 2, 6).Value = Cells(i, 16).Value - 100
Cells(i + 2, 1).Value = 20305
Cells(i + 2, 11).Value = ""
Cells(i + 2, 12).Value = ""
Cells(i + 2, 15).Value = ""
Cells(i + 2, 16).Value = ""
i = i + 1
n = Sheets("Original").Cells(Rows.Count, "A").End(xlUp).Row
ElseIf Cells(i, 16).Value <> "" Then
Cells(i + 1, 16).EntireRow.Insert
Cells(i + 1, 1).EntireRow.Value = Cells(i, 1).EntireRow.Value
Cells(i + 1, 6).Value = Cells(i, 16).Value
Cells(i + 1, 1).Value = 20305
Cells(i + 1, 11).Value = ""
Cells(i + 1, 12).Value = ""
Cells(i + 1, 15).Value = ""
Cells(i + 1, 16).Value = ""
i = i + 1
n = Sheets("Original").Cells(Rows.Count, "A").End(xlUp).Row
End If
Next i
End Sub

If you add or delete rows you need to loop backwards or you'll mess up your indexing, try this:
Sub AddExtrasFerry()
Dim i As Long
Dim n As Long
n = Sheets("Original").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("Original").Select
For i = n To 10 step - 1
If Cells(i, 16).Value <> "" And Cells(i, 3).Value Like "Wood*" And Cells(i, 16).Value = 100 Then
Cells(i + 1, 16).EntireRow.Insert
Cells(i + 1, 1).EntireRow.Value = Cells(i, 1).EntireRow.Value
Cells(i + 1, 6).Value = 100
Cells(i + 1, 1).Value = 20430
Cells(i + 1, 11).Value = ""
Cells(i + 1, 12).Value = ""
Cells(i + 1, 15).Value = ""
Cells(i + 1, 16).Value = ""
ElseIf Cells(i, 16).Value <> "" And Cells(i, 3).Value Like "Wood*" And Cells(i, 16).Value > 100 Then
Cells(i + 1, 16).EntireRow.Insert
Cells(i + 1, 1).EntireRow.Value = Cells(i, 1).EntireRow.Value
Cells(i + 1, 6).Value = 100
Cells(i + 1, 1).Value = 20430
Cells(i + 1, 11).Value = ""
Cells(i + 1, 12).Value = ""
Cells(i + 1, 15).Value = ""
Cells(i + 1, 16).Value = ""
Cells(i + 2, 16).EntireRow.Insert
Cells(i + 2, 1).EntireRow.Value = Cells(i, 1).EntireRow.Value
Cells(i + 2, 6).Value = Cells(i, 16).Value - 100
Cells(i + 2, 1).Value = 20305
Cells(i + 2, 11).Value = ""
Cells(i + 2, 12).Value = ""
Cells(i + 2, 15).Value = ""
Cells(i + 2, 16).Value = ""
ElseIf Cells(i, 16).Value <> "" Then
Cells(i + 1, 16).EntireRow.Insert
Cells(i + 1, 1).EntireRow.Value = Cells(i, 1).EntireRow.Value
Cells(i + 1, 6).Value = Cells(i, 16).Value
Cells(i + 1, 1).Value = 20305
Cells(i + 1, 11).Value = ""
Cells(i + 1, 12).Value = ""
Cells(i + 1, 15).Value = ""
Cells(i + 1, 16).Value = ""
End If
Next i
End Sub

Making a macro execute automatically on any changes to cell value

I have prepared a big spreadsheet and I want that if any of the inputs for the spreadsheet are changed by the user, the module runs automatically to update the sheet.
Sub Biomass()
Cells(5, 4).Value = Cells(10, 17).Value
Cells(4, 1).Value = 0
Cells(5, 1).Value = 1
Cells(4, 6).Value = Cells(1, 17).Value * 50000
Cells(5, 8).Value = Cells(5, 17).Value * 12
Dim c As Long
c = Cells(1, 10).Value * Cells(4, 6).Value
cntr = 0
For i = 6 To (Cells(1, 7).Value + 4)
Cells(i, 4).Value = Cells(i - 1, 4).Value * (1 + Cells(11, 17).Value)
Cells(i, 1).Value = i - 4
Cells(i - 1, 6).Value = Cells(4, 6).Value - ((i - 5) * c)
Cells(i, 6).Value = Cells(4, 6).Value - ((i - 4) * c)
Cells(i - 1, 7).Value = Cells(i - 1, 6).Value / (1 + Cells(1, 2).Value) ^ (i - 5)
Cells(i, 7).Value = Cells(i, 6).Value / (1 + Cells(1, 2).Value) ^ (i - 4)
Cells(i - 1, 5).Value = (Cells(i - 1, 4).Value / (1 + Cells(1, 2).Value) ^ (i - 5)) + Cells(i - 2, 5)
Cells(i, 5).Value = (Cells(i, 4).Value / (1 + Cells(1, 2).Value) ^ (i - 4)) + Cells(i - 1, 5)
Cells(i, 8).Value = Cells(i - 1, 8).Value * (1 - Cells(13, 17).Value)
Cells(i - 1, 9).Value = Cells(i - 1, 8).Value / ((1 + Cells(1, 2).Value) ^ (i - 5))
Cells(i, 9).Value = Cells(i, 8).Value / ((1 + Cells(1, 2).Value) ^ (i - 4))
Cells(5, 10).Value = Cells(5, 9).Value
Cells(i, 10).Value = Cells(i - 1, 10).Value + Cells(i, 9).Value
Cells(i - 1, 11).Value = Cells(14, 17).Value / (1 + Cells(1, 2).Value) ^ (i - 5)
Cells(i, 11).Value = Cells(14, 17).Value / (1 + Cells(1, 2).Value) ^ (i - 4)
Cells(4, 12).Value = 0
Cells(i - 1, 12) = Cells(i - 2, 12).Value + Cells(i - 1, 11).Value
Cells(i, 12).Value = Cells(i - 1, 12).Value + Cells(i, 11).Value
Cells(i - 1, 13).Value = (Cells(2, 17).Value + Cells(i - 1, 5).Value - Cells(i - 1, 12).Value - Cells(i - 1, 7).Value) / Cells(i - 1, 10).Value
Cells(i, 13).Value = (Cells(2, 17).Value + Cells(i, 5).Value - Cells(i, 12).Value - Cells(i, 7).Value) / Cells(i, 10).Value
cntr = cntr + 1
If cntr = 24 Then Exit For
Next i
For g = 5 To (Cells(35, 17).Value + 4)
Cells(g, 3).Value = Cells(36, 17).Value
Next g
cntr2 = 0
For d = 5 To (Cells(1, 7).Value + 4)
Cells(d, 2).Value = Cells(21, 17).Value * Cells(d, 8).Value + Cells(d, 3).Value - Cells(d, 4).Value
cntr2 = cntr2 + 1
If cntr2 = 25 Then Exit For
Next d
cntr3 = 0
For i = (cntr + 7) To (Cells(1, 7).Value + 4)
Cells(30, 6).Value = Cells(4, 6).Value * (1 + Cells(1, 4).Value) ^ 30
c2 = Cells(1, 10).Value * Cells(30, 6).Value
Cells(30, 4).Value = Cells(5, 4).Value
Cells(i, 4).Value = Cells(i - 1, 4).Value * (1 + Cells(11, 17).Value)
Cells(i, 1).Value = i - 4
Cells(i, 6).Value = Cells(30, 6).Value - ((i - 30) * c2)
Cells(i - 1, 7).Value = Cells(i - 1, 6).Value / (1 + Cells(1, 2).Value) ^ (i - 5)
Cells(i, 7).Value = Cells(i, 6).Value / (1 + Cells(1, 2).Value) ^ (i - 4)
Cells(i - 1, 5).Value = (Cells(i - 1, 4).Value / (1 + Cells(1, 2).Value) ^ (i - 5)) + Cells(i - 2, 5)
Cells(i, 5).Value = (Cells(i, 4).Value / (1 + Cells(1, 2).Value) ^ (i - 4)) + Cells(i - 1, 5)
Cells(30, 8).Value = Cells(5, 8).Value
Cells(i, 8).Value = Cells(i - 1, 8).Value * (1 - Cells(13, 17).Value)
Cells(i - 1, 9).Value = Cells(i - 1, 8).Value / ((1 + Cells(1, 2).Value) ^ (i - 5))
Cells(i, 9).Value = Cells(i, 8).Value / ((1 + Cells(1, 2).Value) ^ (i - 4))
Cells(30, 10).Value = Cells(30, 9).Value + Cells(29, 10).Value
Cells(i, 10).Value = Cells(i - 1, 10).Value + Cells(i, 9).Value
Cells(i - 1, 11).Value = Cells(14, 17).Value / (1 + Cells(1, 2).Value) ^ (i - 5)
Cells(i, 11).Value = Cells(14, 17).Value / (1 + Cells(1, 2).Value) ^ (i - 4)
Cells(i - 1, 12) = Cells(i - 2, 12).Value + Cells(i - 1, 11).Value
Cells(i, 12).Value = Cells(i - 1, 12).Value + Cells(i, 11).Value
Cells(i - 1, 13).Value = (Cells(2, 17).Value + Cells(i - 1, 5).Value - Cells(i - 1, 12).Value - Cells(i - 1, 7).Value) / Cells(i - 1, 10).Value
Cells(i, 13).Value = (Cells(2, 17).Value + Cells(i, 5).Value - Cells(i, 12).Value - Cells(i, 7).Value) / Cells(i, 10).Value
cntr3 = cntr3 + 1
If cntr3 = 25 Then Exit For
Next i
cntr4 = 0
For d = 30 To (Cells(1, 7).Value + 4)
Cells(d, 2).Value = Cells(21, 17).Value * Cells(d, 8).Value + Cells(d, 3).Value - Cells(d, 4).Value
cntr4 = cntr4 + 1
If cntr4 = 25 Then Exit For
Next d
End Sub
As you can see, cells(10,17)(1,17)(25,17)(5,17)(17,17)(4,6)(11,17)(5,9)(1,7)(24,17)(5,10) are the cells on changing any of which the sub should run automatically.

The following should be able to solve your problem.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("INPUT RANGE")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
' YOUR CODE GOES HERE
End If
End Sub
Just change the INPUT RANGE and input your code where I have marked.

Resources