Note that there are some explanatory texts on larger screens.

plurals
  1. POOptimize code to minimize runtime of the macro
    primarykey
    data
    text
    <p>I have been writing some macros to perform some astrological calculations (calculating sign, lunar mansion, D9 &amp; D60). The raw data is in the following format:</p> <p><img src="https://i.stack.imgur.com/c63KX.jpg" alt="input data format"></p> <p>lng in the above image stands for longitude expressed in degree,minute,second format. The output has to be in the following format:</p> <p><img src="https://i.stack.imgur.com/1jBre.jpg" alt="output data layout"></p> <p>I have whipped up the following code to read the data from the input sheet and format &amp; copy it to the output sheet then do calculations with the longitude of each planet to calculate required fields.</p> <pre><code>Sub prepareOutput() Application.ScreenUpdating = False Dim c, count, d, l, ll Dim r As Range Set r = Worksheets("Ephemerides").Range("a4:" &amp; Worksheets("Ephemerides").Range("a4").End(xlDown).Address) Worksheets("output").Range("a3").Value = "Date" For Each d In r Worksheets("output").Cells(d.Row, 1).Value = d.Value Next For Each c In Worksheets("Ephemerides").Range("d2:o2") If Not IsEmpty(c) Then count = count + 5 'MsgBox count If count = 5 Then Worksheets("output").Cells(2, 2).Value = c.Value Worksheets("output").Cells(3, 2).Value = "Longitude" Worksheets("output").Cells(3, 3).Value = "Sign" Worksheets("output").Cells(3, 4).Value = "Nakshatra" Worksheets("output").Cells(3, 5).Value = "Navamsa" Worksheets("output").Cells(3, 6).Value = "D60" For Each l In Worksheets("Ephemerides").Range(c.Offset(2, 0), c.End(xlDown).Address) Worksheets("output").Cells(l.Row, 2).Value = l.Value Worksheets("output").Cells(l.Row, 3).Value = calcSign(l.Value) Next count = 2 Else Worksheets("output").Cells(2, count).Value = c.Value Worksheets("output").Cells(3, count).Value = "Longitude" Worksheets("output").Cells(3, count + 1).Value = "Sign" Worksheets("output").Cells(3, count + 2).Value = "Nakshatra" Worksheets("output").Cells(3, count + 3).Value = "Navamsa" Worksheets("output").Cells(3, count + 4).Value = "D60" For Each ll In Worksheets("Ephemerides").Range(c.Offset(2, 0), c.End(xlDown).Address) Worksheets("output").Cells(ll.Row, count).Value = ll.Value Worksheets("output").Cells(ll.Row, count + 1).Value = calcSign(ll.Value) Next End If End If Next Application.ScreenUpdating = True End Sub Private Function deg2dec(deg As String) As Variant d = Val(Mid(deg, 1, InStr(deg, "°") - 1)) m = Val(Mid(deg, InStr(deg, "°") + 1, 2)) / 100 deg2dec = d + m End Function Private Function calcSign(deg As String) As String dec = deg2dec(deg) Select Case dec Case 0 To 30 calcSign = "Aries" Case 30 To 60 calcSign = "Taurus" Case 60 To 90 calcSign = "Gemini" Case 90 To 120 calcSign = "Cancer" Case 120 To 150 calcSign = "Leo" Case 150 To 180 calcSign = "Virgo" Case 180 To 210 calcSign = "Libra" Case 210 To 240 calcSign = "Scorpio" Case 240 To 270 calcSign = "Saggitarius" Case 270 To 300 calcSign = "Capricorn" Case 300 To 330 calcSign = "Aquarius" Case 330 To 360 calcSign = "Pisces" End Select End Function </code></pre> <p>The above code doesn't calculate all 4 computed fields, just one for now.</p> <p>The problem I am having is that I have 24000 rows and 12 columns in my input sheet and it is taking a lot of time to just copy this data to the output sheet and then doing calculations on it to compute one more value.And I have to calculate 3 more fields from one longitude value.</p> <p>So if you guys could take a look at the code and let me know how i could go about minimizing the runtime here, that would help a lot.</p> <p>Here's the link to the workbook if anyone wants to take a look. <a href="https://drive.google.com/file/d/0B8OgQf1g9iFqWXVUU001ZFNKVWM/edit?usp=sharing" rel="nofollow noreferrer">astro.xlsm</a></p> <p>Thanks in advance to all those who take out time to reply.</p> <p>Cheers</p>
    singulars
    1. This table or related slice is empty.
    plurals
    1. This table or related slice is empty.
    1. This table or related slice is empty.
    1. This table or related slice is empty.
    1. This table or related slice is empty.
    1. This table or related slice is empty.
 

Querying!

 
Guidance

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload