Hi friends, I have been writing some macros to perform some astrological calculations (calculating sign, lunar mansion, D9 & D60). The raw data is in the following format:
<https://lh4.googleusercontent.com/-7nJtQ1W-1EE/UrScWWJu6ZI/AAAAAAAAAJo/_iag0cmoea4/s1600/input.jpg> lng in the above image stands for longitude expressed in degree,minute,second format. The output has to be in the following format: <https://lh5.googleusercontent.com/-nBhv-Kcs-IY/UrSdVVX3kBI/AAAAAAAAAJw/RlEBegMuXl8/s1600/output.jpg> I have whipped up the following code to read the data from the input sheet and format & copy it to the output sheet then do calculations with the longitude of each planet to calculate required fields. Sub prepareOutput() Application.ScreenUpdating = False Dim c, count, d, l, ll Dim r As Range Set r = Worksheets("Ephemerides").Range("a4:" & 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 The above code doesn't calculate all 4 computed fields, just one for now. 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. 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. Thanks in advance to all those who take out time to reply. Cheers -- Are you =EXP(E:RT) or =NOT(EXP(E:RT)) in Excel? And do you wanna be? It’s =TIME(2,DO:IT,N:OW) ! Join official Facebook page of this forum @ https://www.facebook.com/discussexcel FORUM RULES 1) Use concise, accurate thread titles. Poor thread titles, like Please Help, Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get quick attention or may not be answered. 2) Don't post a question in the thread of another member. 3) Don't post questions regarding breaking or bypassing any security measure. 4) Acknowledge the responses you receive, good or bad. 5) Jobs posting is not allowed. 6) Sharing copyrighted material and their links is not allowed. NOTE : Don't ever post confidential data in a workbook. Forum owners and members are not responsible for any loss. --- You received this message because you are subscribed to the Google Groups "MS EXCEL AND VBA MACROS" group. To unsubscribe from this group and stop receiving emails from it, send an email to excel-macros+unsubscr...@googlegroups.com. To post to this group, send email to excel-macros@googlegroups.com. Visit this group at http://groups.google.com/group/excel-macros. For more options, visit https://groups.google.com/groups/opt_out.
