• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Calculation using VBA Macro

karthick87

karthick87

Member
I have two sheets (Sheet1 and Sheet2). Sheet1 has the student (Practical and Theory Marks) for 6 semesters. Where this 6 semester is classified as below,

Year1 - Sem1 and Sem2
Year2 - Sem3 and Sem4
Year3 - Sem5 and Sem6

I need to consolidate the marks by adding Sem1 and Sem2 marks in Sheet1 and then paste the result in Sheet2 (For example, Year1 results include addition of Sem1+Sem2 and the addition results should go into Sheet2 =C3:C7 and =C8:C12) using a macro without loosing the cell color. Anyhelp would be appreciated. Attached the sample file.
 

Attachments

  • Student1.xlsx
    10.2 KB · Views: 10
Hello @Marc L, so there are two reasons for choosing the code than formula,

Reason1:
I am working on a student database which is fully automated in excel and some minor changes need to be added there (which is the one mentioned above). Also I am learning VBA stuff and wanted to enhance it to the next level. So thought of taking this opportunity to do this stuff via VBA. I know the way to copy cells from one sheet to another sheet. But just thinking how we can add two cells and then copy the results alone to "Sheet2".

Worksheets("Sheet1").Range("C2:C6").Copy Worksheets("Sheet2").Range("C3:C7")
Click to expand...

Reason2:
Yes, I can use a formula too. I have tried the below formula too in Sheet2 in C3 and then dragged the formula upto C7. I see the cell value in the formula has changed, however the calculated value is not correct. So I double click on each cell again manually and the calculation appears correct. Not sure, what made my excel to behave in such a manner.

=Sheet1!C2+Sheet1!C8
Click to expand...

Attached a GIF file below, to make it more clear. If you see initially all the cells (C2:C7) has the same value 220 which is not correct. After clicking on individual cells, it becomes the correct value.
O3651.gif
 
  • Like
Reactions: vk7
IT is neat how you did the GIF.

For (2), you probably have Sheet Calculation set to Manual.

If you just need a value and don't want them to update when data in sheet1 changes, you can do a copy paste special for your added formulas. If you have the formula updated right, then that would make the values static.

If static values or added formulas is needed by VBA, we can show how that is done. Let us know what help if any you still need.
 
@Kenneth Hobson, thank you for the pointers. Yes, as you said "Calculation Option" was set to "Manual". Good catch, I have never noticed this earlier. I have set it back to "Automatic" now and it works fine.

Could you show me an example, how this added formula can be used in VBA? Basically, I have a defined set of formula's for each cell and that needs to be applied using VBA because Sheet1 is not static. When Sheet1 is destroyed and re-added with the same name, then all of my formula's were missing the reference Sheet name and therefore the calculation doesn't happen.

Static.PNG
 
Last edited:
Always test on backup copy. This can be improved with a few loops. Here, I just copy the values. Formulas could have been used easily enough. I have not checked this fully but should be close.

In a Module:
Code: 
Sub DemoFormulas()
  Dim ws1 As Worksheet, ws2 As Worksheet
 
  Set ws1 = ThisWorkbook.Worksheets("Sheet1")
  Set ws2 = ThisWorkbook.Worksheets("Sheet2")
 
  With ws1
    'Temp formulas
    .[E2].Formula = "=B2+B8"
    .[E2].Copy
    .[E2:F36].PasteSpecial xlFormulas
   
    'Copy formula values to ws2:
   
    'Year 1
    .[E2:E6].Copy
    ws2.[C8].PasteSpecial xlValues
    .[F2:F6].Copy
    ws2.[C3].PasteSpecial xlValues
   
    'Year 2
    .[E14:E18].Copy
    ws2.[F8].PasteSpecial xlValues
    .[F14:F18].Copy
    ws2.[F3].PasteSpecial xlValues
   
    'Year 3
    .[E26:E30].Copy
    ws2.[I8].PasteSpecial xlValues
    .[F26:F30].Copy
    ws2.[I3].PasteSpecial xlValues
   
    'Remove temp formulas
    '.[E2:F36].ClearContents
  End With
 
 
  Application.CutCopyMode = False
End Sub
 
karthick87 said:
however the calculated value is not correct.
Click to expand...
karthick87 said:
Could you show me an example,
how this added formula can be used in VBA?
Click to expand...
Just try first this classic way following TEBV rule :
Code: 
Sub Demo1()
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationAutomatic
With [Sheet2!C3:C7]
    .Formula = "=Sheet1!C2+Sheet1!C8"
    .Formula = .Value
End With
With [Sheet2!C8:C12]
    .Formula = "=Sheet1!B2+Sheet1!B8"
    .Formula = .Value
End With
With [Sheet2!F3:F7]
    .Formula = "=Sheet1!C14+Sheet1!C20"
    .Formula = .Value
End With
With [Sheet2!F8:F12]
    .Formula = "=Sheet1!B14+Sheet1!B20"
    .Formula = .Value
End With
With [Sheet2!I3:I7]
    .Formula = "=Sheet1!C26+Sheet1!C32"
    .Formula = .Value
End With
With [Sheet2!I8:I12]
    .Formula = "=Sheet1!B26+Sheet1!B32"
    .Formula = .Value
End With
        Application.ScreenUpdating = True
End Sub
Do you like it ? So thanks to click on bottom right Like !
​
 
For these easy beginner formulas my favorite is to
direct Evaluate (a must see method in VBA inner help) :​
Code: 
Sub Demo2()
     [Sheet2!C3:C7] = [Sheet1!C2:C6+Sheet1!C8:C12]
    [Sheet2!C8:C12] = [Sheet1!B2:B6+Sheet1!B8:B12]
     [Sheet2!F3:F7] = [Sheet1!C14:C18+Sheet1!C20:C24]
    [Sheet2!F8:F12] = [Sheet1!B14:B18+Sheet1!B20:B24]
     [Sheet2!I3:I7] = [Sheet1!C26:C30+Sheet1!C32:C36]
    [Sheet2!I8:I12] = [Sheet1!B26:B30+Sheet1!B32:B36]
End Sub
You may Like it !

Think Excel Before VBA !
​
 
An algorithmic loop alternative :​
Code: 
Sub Demo3()
    For N% = 0 To 2
         [Sheet2!C3:C7].Offset(, N * 3) = Evaluate([Sheet1!C2:C6].Offset(N * 12).Address(, , , True) & "+" & [Sheet1!C8:C12].Offset(N * 12).Address(, , , True))
        [Sheet2!C8:C12].Offset(, N * 3) = Evaluate([Sheet1!B2:B6].Offset(N * 12).Address(, , , True) & "+" & [Sheet1!B8:B12].Offset(N * 12).Address(, , , True))
    Next
End Sub
You should Like it !
​
 
Last but not least, imagine you have to calculate 5 years,
worksheets respecting same layout and structure :
- with Demo1 & 2 you must mod code to add formulas.
- With Demo3 you just have to mod the upper bound (red mod) :
For N% = 0 To 4
and nothing else !

But if one time it's 3 years, another time it's 5 years and next it's 4 years,
better is to detect the desired number of years for example from Sheet2 :​
Code: 
Sub Demo4()
              Dim N%, Rg As Range
For N = 0 To (Sheet2.Cells(2, Columns.Count).End(xlToLeft).Column / 3) - 1
    With [Sheet2!C3:C7].Offset(, N * 3)
                  Set Rg = [Sheet1!C2:C6].Offset(N * 12)
                  .Value = Evaluate(Rg.Address(, , , True) & "+" & Rg.Offset(6).Address(, , , True))
        .Offset(5).Value = Evaluate(Rg.Offset(, -1).Address(, , , True) & "+" & Rg.Offset(6, -1).Address(, , , True))
    End With
Next
                  Set Rg = Nothing
End Sub
You could Like it !

Think, But Think Object !
​
 
@Marc L, I tried using the direct evaluate method but then I noticed there is some character limitation per line I guess. Is that correct?

Coz, I was getting "Compile Error, identifier too long".
 

No issue on my side whatever the demonstration with your
initial attachment and those formulas in Demo2 are not long !

Post your mod code (via icon or between code tags).
​
 
@Marc L , please see the attached file and the formula commented in the macro. Because of the length it is giving out the error. It seems shortening the Sheet Name will fix this issue for now. However, we would like to have the same name. The original formula which you have mentioned above is not giving out the error. It is working fine as expected. However, to calculate one another value, we have used a formula, which is resulting in an error.

In this case, what best can be done? Or how we can shorten the formula? Any help would be appreciated!
 

Attachments

  • Student1.xlsm
    18.2 KB · Views: 10
As it seems to have a 255 chars limit on direct evaluation :​
Code: 
Sub Demo5a()
    [Sheet2!C14] = [('Students Mark Sheet'!C2+'Students Mark Sheet'!C8)/2+'Students Mark Sheet'!C3+'Students Mark Sheet'!C9+('Students Mark Sheet'!C4+'Students Mark Sheet'!C10)/20+'Students Mark Sheet'!C5+'Students Mark Sheet'!C11-40] + _
                   [('Students Mark Sheet'!C6+'Students Mark Sheet'!C12)/10+('Students Mark Sheet'!C14+'Students Mark Sheet'!C20)/2+'Students Mark Sheet'!C15+'Students Mark Sheet'!C21+('Students Mark Sheet'!C16+'Students Mark Sheet'!C22)/20] + _
                   ['Students Mark Sheet'!C17+'Students Mark Sheet'!C23-40+('Students Mark Sheet'!C18+'Students Mark Sheet'!C24)/10]
End Sub
You may Like it !
​
 
An alternative :​
Code: 
Sub Demo5b()
    For Each VF In Array("(#C2+#C8)/2+#C3+#C9+(#C4+#C10)/20+#C5", "#C11-40+(#C6+#C12)/10+(#C14+#C20)/2+#C15+#C21", "(#C16+#C22)/20+#C17+#C23-40+(#C18+#C24)/10")
        VA = VA + Evaluate(Replace(VF, "#", "'" & Sheet1.Name & "'!"))
    Next
        [Sheet2!C14].Value = VA
End Sub
You should Like it !
​
 
Respecting TEBV rule :​
Code: 
Sub Demo5c()
    For Each VF In Split("(#C2+#C8)/2+#C3+#C9+(#C4+#C10)/20+#C5 #C11-40+(#C6+#C12)/10+(#C14+#C20)/2+#C15+#C21 (#C16+#C22)/20+#C17+#C23-40+(#C18+#C24)/10")
        VA = VA + Evaluate(Replace(VF, "#", "'" & Sheet1.Name & "'!"))
    Next
        [Sheet2!C14].Value = Application.RoundUp(VA, 0)
End Sub
You could Like it !
​
 
You must log in or register to reply here.
Back
Top