Sum specific rows as even and odd

YasserKhalil
PlatinumLounger
Posts: 4911
Joined: 31 Aug 2016, 09:02

Sum specific rows as even and odd

Post by YasserKhalil »

Hello everyone
I have two worksheets .. Salary and TB
and I have this macro that extracts results in specific way .. for each ID there will be two rows of results

Code: Select all

Sub Test()
    Dim wsSalary As Worksheet
    Dim wsTB As Worksheet
    Dim a As Variant
    Dim b As Variant
    Dim aFT As Variant
    Dim aSD As Variant
    Dim m As Long
    Dim i As Long
    Dim j As Long
    Dim n As Long
    
    Application.ScreenUpdating = False
        Set wsSalary = ThisWorkbook.Worksheets("Salary")
        Set wsTB = ThisWorkbook.Worksheets("TB")
        m = wsSalary.Cells(Rows.Count, 1).End(xlUp).Row - 2
        If m = 1 Then Exit Sub
        a = wsSalary.Range("A2:CM" & m).Value
        ReDim b(1 To 2 * (UBound(a, 1) + Application.RoundUp(UBound(a, 1) / 15, 0)), 1 To 35)
        
        aFT = Array(1, 16, 17, 18, 19, 20, 21, 22, , 38, 39, 41, 40, 42, 43, 45, 44, 29, 30, 34, 32, 33, 35, 48, 49, 50, 51, , 54, 53, 55, 91, 2, 8, 14)
        aSD = Array(, 56, 57, 58, 60, 61, , 63, 64, 66, , 59, 64, 65, 67, 70, 68, 69, 71, 79, 78, 81, 82, 83, 74, 85, 86, 87, 90)
        
        For i = LBound(a, 1) To UBound(a, 1)
            n = n + 1
            For j = 1 To UBound(b, 2)
                If Not IsMissing(aFT(j - 1)) Then b(n, j) = a(i, aFT(j - 1))
            Next j
            
            n = n + 1
            For j = 1 To UBound(b, 2)
                If j = 30 Then Exit For
                If Not IsMissing(aSD(j - 1)) Then b(n, j) = a(i, aSD(j - 1))
            Next j
        Next i
        
        wsTB.Range("A6").Resize(UBound(b, 1), UBound(b, 2)).Value = b
    Application.ScreenUpdating = True
End Sub
The code is working well at this point. What I need is to insert three rows after each 30 rows and at the end there will be three more rows
Two of these three rows would contain the totals for rows alternatively
I have put the rows manually so as to display the issue well (the columns will be from column B to column AF in TB sheet)

Thanks advanced for help
You do not have the required permissions to view the files attached to this post.

User avatar
HansV
Administrator
Posts: 78236
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Sum specific rows as even and odd

Post by HansV »

It's dinner time here now. I'll check later on if there is no reply.
Best wishes,
Hans

YasserKhalil
PlatinumLounger
Posts: 4911
Joined: 31 Aug 2016, 09:02

Re: Sum specific rows as even and odd

Post by YasserKhalil »

Thank you very much Mr. Hans for your kind reply
Take your time. I am not in hurry
Have a nice meal

User avatar
HansV
Administrator
Posts: 78236
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Sum specific rows as even and odd

Post by HansV »

This request is a bit over the top, in my opinion. Eileen's Lounge is not intended to develop commercial solutions for free.
Best wishes,
Hans

YasserKhalil
PlatinumLounger
Posts: 4911
Joined: 31 Aug 2016, 09:02

Re: Sum specific rows as even and odd

Post by YasserKhalil »

Thanks for reply but this is not commercial. This is personal ... or I misunderstand the reply
The code is already there and I just need addition of how to insert totals for each block of 30 rows ..
Thanks anyway Mr. Hans

YasserKhalil
PlatinumLounger
Posts: 4911
Joined: 31 Aug 2016, 09:02

Re: Sum specific rows as even and odd

Post by YasserKhalil »

I have searched till I can find something that may contribute to the solution
This is a UDF

Code: Select all

Function SumIntervalRows(rng As Range, interval As Integer) As Double
    Dim arr As Variant
    Dim total As Double
    Dim i As Long
    
    total = 0
    arr = rng.Value
    
    For i = LBound(arr, 1) To UBound(arr, 1) Step interval
        total = total + arr(i, 1)
    Next i
    
    SumIntervalRows = total
End Function
And I used in this way

Code: Select all

=SumIntervalRows(B6:B35,2)
Then drag down and left and it works well

The problem for me now how to insert the three rows for each block of 30 rows and how to determine the range to sum or put the udf to suit ..
Thanks advanced for help

YasserKhalil
PlatinumLounger
Posts: 4911
Joined: 31 Aug 2016, 09:02

Re: Sum specific rows as even and odd

Post by YasserKhalil »

In the main code I have added a line that enables me to get three empty rows

Code: Select all

            If n Mod 30 = 0 Then n = n + 3
        Next i
Now I have just one point .. which is how to put the formula of the udf to suit each range ..?

YasserKhalil
PlatinumLounger
Posts: 4911
Joined: 31 Aug 2016, 09:02

Re: Sum specific rows as even and odd

Post by YasserKhalil »

I could reach a not so good solution till now
this part is added

Code: Select all

            If n Mod 30 = 0 Then
                For c = 2 To 32
                    x = 0
                    For r = (n - 30) + 1 To n Step 2
                        x = x + Val(b(r, c))
                    Next r
                    b(n + 1, c) = x
                    
                    x = 0
                    For r = (n - 30) + 2 To n Step 2
                        x = x + Val(b(r, c))
                    Next r
                    b(n + 2, c) = x
                Next c
                n = n + 3
            End If
        Next i
this works only for the first 30 rows but not with the rest of rows !!!!

Can you help me please make this working for the rest of the rows?

YasserKhalil
PlatinumLounger
Posts: 4911
Joined: 31 Aug 2016, 09:02

Re: Sum specific rows as even and odd

Post by YasserKhalil »

I have followed the lines of code and found that n in the first part is ok as I intend to deal with 30 rows .. but after n = n + 3 , the situation became different as this part of using Mod will not work .. How can I edit the code so as to make the Mod part works for my needs

YasserKhalil
PlatinumLounger
Posts: 4911
Joined: 31 Aug 2016, 09:02

Re: Sum specific rows as even and odd

Post by YasserKhalil »

Any help with that point only ...? I need to adjust the code so as to have totals for each 30 rows .. It is now done for the first block only

User avatar
Doc.AElstein
BronzeLounger
Posts: 1499
Joined: 28 Feb 2015, 13:11
Location: Hof, Bayern, Germany

Re: Sum specific rows as even and odd

Post by Doc.AElstein »

Hi Yasser,
I am not sure if I fully understand what you want.. So I do not understand enough to give you full answer. I do not follow your explanations fully.
It is difficult for me to follow what you have done and are doing ???

But maybe here some ideas to help..
Just some ideas.

Remember this:
http://www.eileenslounge.com/viewtopic. ... 50#p241197" onclick="window.open(this.href);return false;
and this
http://www.eileenslounge.com/viewtopic. ... 60#p242289" onclick="window.open(this.href);return false;

If you have
Range("B36").value = “=SUM(B6,B8,B10,B12,B14,B16,B18,B20,B22,B24,B26,B28,B30,B32,B34)”
Then you can paste in “fixed vector” notation , “=SUM(B6,B8,B10,B12,B14,B16,B18,B20,B22,B24,B26,B28,B30,B32,B34)” , across whole range
Like you try now
Let Range("B36:AF36").Value = "=SUM(B6,B8,B10,B12,B14,B16,B18,B20,B22,B24,B26,B28,B30,B32,B34)"
This gives you same results as your test data for row 36. Code does like drag across similar to .

Code: Select all

Sub Formula()
 Debug.Print Range("B36").Formula
 Let Range("B36:AF36").Value = "=SUM(B6,B8,B10,B12,B14,B16,B18,B20,B22,B24,B26,B28,B30,B32,B34)"
End Sub
_._______________________________________

How about Function, FuncyFormula, to build the “fixed vector” notation formula ?

Code: Select all

Sub FuncyTestie()
 Call FuncyFormula(34, 6)
 Debug.Print
 Debug.Print
End Sub
Function FuncyFormula(ByVal BL As Long, ByVal TL As Long) As String
Dim Cnt As Long
    For Cnt = BL To TL Step -2
    Dim MeStrungOut As String
     Let MeStrungOut = ",B" & Cnt & MeStrungOut
    Next Cnt
 Let MeStrungOut = Replace(MeStrungOut, ",", "", 1, 1, vbBinaryCompare) 'take off just 1 ","
 Let FuncyFormula = "=sum(" & MeStrungOut & ")"
Debug.Print "FuncyFormula is   " & FuncyFormula
End Function
_._________________________


Then do a loop to put in the formulas based on the Top left, TL , and Bottom left, BL of your ranges…
Demo code ( needs also Function, FuncyFormula )

Code: Select all

Sub DoSomefinkMayBee()
Dim arrTLBL() As Variant: Let arrTLBL() = Array(6, 35, 39, 46)
Dim Cnt As Long
    For Cnt = 0 To UBound(arrTLBL) Step 2
    Dim MeFormula As String
    ' First Formula row
     Let MeFormula = FuncyFormula(arrTLBL(Cnt + 1) - 1, arrTLBL(Cnt)): Debug.Print "MeFormula for Some first row, " & arrTLBL(Cnt + 1) + 1 & ", is    " & MeFormula
     Let Range("B" & arrTLBL(Cnt + 1) + 1 & ":AF" & arrTLBL(Cnt + 1) + 1 & "").Value = MeFormula
    ' Second Formula row
     Let MeFormula = FuncyFormula(arrTLBL(Cnt + 1), arrTLBL(Cnt) + 1): Debug.Print "MeFormula for Some second row, " & arrTLBL(Cnt + 1) + 2 & ", is    " & MeFormula
     Let Range("B" & arrTLBL(Cnt + 1) + 2 & ":AF" & arrTLBL(Cnt + 1) + 2 & "").Value = MeFormula
    Next Cnt
End Sub
If you look at Immediate window, then I think you can see what is going on:
FunkyFormulas.JPG : https://imgur.com/ineKHLU" onclick="window.open(this.href);return false;
FunkyFormulas.JPG
FuncyFormula is =sum(B6,B8,B10,B12,B14,B16,B18,B20,B22,B24,B26,B28,B30,B32,B34)


FuncyFormula is =sum(B6,B8,B10,B12,B14,B16,B18,B20,B22,B24,B26,B28,B30,B32,B34)
MeFormula for Some first row, 36, is =sum(B6,B8,B10,B12,B14,B16,B18,B20,B22,B24,B26,B28,B30,B32,B34)
FuncyFormula is =sum(B7,B9,B11,B13,B15,B17,B19,B21,B23,B25,B27,B29,B31,B33,B35)
MeFormula for Some second row, 37, is =sum(B7,B9,B11,B13,B15,B17,B19,B21,B23,B25,B27,B29,B31,B33,B35)


FuncyFormula is =sum(B39,B41,B43,B45)
MeFormula for Some first row, 47, is =sum(B39,B41,B43,B45)
FuncyFormula is =sum(B40,B42,B44,B46)
MeFormula for Some second row, 48, is =sum(B40,B42,B44,B46)




Alan
You do not have the required permissions to view the files attached to this post.
I am having difficulty logging in with this account just now.
You can find me at DocAElstein also

YasserKhalil
PlatinumLounger
Posts: 4911
Joined: 31 Aug 2016, 09:02

Re: Sum specific rows as even and odd

Post by YasserKhalil »

Thanks a lot Mr. Alan for reply
In fact I have the working code but need just help one point.
To start over the issue I will attach a new sample with the latest code ....

In the attachment run the code 'Test' and notice the rows 36 and 37 (these rows have the totals of alternative rows and these results are correct)
What I need to do is to insert the same result after another 30 rows >> so in rows 69 and 70 I expect to have the same result as rows 36 and 37
And also at the end of data I need to have the totals too as explained
Hope this is clear now
You do not have the required permissions to view the files attached to this post.

User avatar
macropod
4StarLounger
Posts: 508
Joined: 17 Dec 2010, 03:14

Re: Sum specific rows as even and odd

Post by macropod »

In cell B36, insert the array formula:
=SUM(IF(MOD(ROW(B$5:B$35)-CELL("Row",B$5:B$35),2)=MOD(ROW()-1,2),B$5:B$35,))
Copy down to B37 and across as far as needed.

In cell B47, insert the array formula:
=SUM(IF(MOD(ROW(B$38:B$46)-CELL("Row",B$38:B$46),2)=MOD(ROW(),2),B$38:B$46,))
Copy down to B48 and across as far as needed.
Paul Edstein
[Fmr MS MVP - Word]

YasserKhalil
PlatinumLounger
Posts: 4911
Joined: 31 Aug 2016, 09:02

Re: Sum specific rows as even and odd

Post by YasserKhalil »

Thanks a lot for reply
I have already the code in the attachment and I just need to edit the code to be able to insert totals for each block of 30 rows..

YasserKhalil
PlatinumLounger
Posts: 4911
Joined: 31 Aug 2016, 09:02

Re: Sum specific rows as even and odd

Post by YasserKhalil »

I have posted the thread here too
https://www.excelforum.com/excel-progra ... ost5021708" onclick="window.open(this.href);return false;

User avatar
macropod
4StarLounger
Posts: 508
Joined: 17 Dec 2010, 03:14

Re: Sum specific rows as even and odd

Post by macropod »

YasserKhalil wrote:Thanks a lot for reply
I have already the code in the attachment and I just need to edit the code to be able to insert totals for each block of 30 rows..
As can be seen from the formulae I posted, all you need do is identify the first and last rows. Your code doesn't need to identify the intervening rows.
Paul Edstein
[Fmr MS MVP - Word]

User avatar
Doc.AElstein
BronzeLounger
Posts: 1499
Joined: 28 Feb 2015, 13:11
Location: Hof, Bayern, Germany

Re: Sum specific rows as even and odd

Post by Doc.AElstein »

Hi Yasser,
I would need a day to work through your code to understand your logic. ( If you had some ‘comments , then maybe I could understand easier. )
That is my problem: To modify your code I would need to understand it. I need a day for that.

I think me and Paul’s solution are similar. We give you a solution which puts in the formulas you want , You just need to identify the first and last rows. Our solutions put the formulas where your original test data showed them.

For this…_
YasserKhalil wrote: in rows 69 and 70 I expect to have the same result as rows 36 and 37
_... then
_......in my solution , instead of
arrTLBL() = Array(6, 35, 39, 46),
use
arrTLBL() = Array(6, 35, 39 , 68),

_.......For Paul’s solution… .._
macropod wrote:As can be seen from the formulae I posted, all you need do is identify the first and last rows..
_......
In cell B36, insert the array formula: … =SUM(IF(MOD(ROW(B$5:B$35)-CELL("Row",B$5:B$35),2)=MOD(ROW()-1,2),B$5:B$35,))
In cell B69, insert the array formula: … =SUM(IF(MOD(ROW(B$38:B$68)-CELL("Row",B$38:B$68),2)=MOD(ROW()-1,2),B$38:B$68,))

Code: Select all

 Sub Paul()
 Range("B36").FormulaArray = "=SUM(IF(MOD(ROW(B$5:B$35)-CELL(""Row"",B$5:B$35),2)=MOD(ROW()-1,2),B$5:B$35,))"
 Range("B69").FormulaArray = "=SUM(IF(MOD(ROW(B$38:B$68)-CELL(""Row"",B$38:B$68),2)=MOD(ROW()-1,2),B$38:B$68,))"
End Sub
( I do not understand anything about those formulas, but they seem to give the correct results )
_.________________________________

If you really want your code modified, then you must help me to understand it with adding some ‘Comments. Otherwise it is a lot of work for me to understand it first.
Also I think you must try to give us better test data. Show exactly what you want. I still do not understand your explanation along with your data

My guess is that you want the output results in my worksheet MyGuessAfter in uploaded File. But I am guessing this only because you have not explained or shown this.
_._____

To get my formals into the worksheet, “MyGuess” or worksheet “MyGuessAfter” I use
arrTLBL() = Array(6, 35, 39, 68, 72, 91),

The Full code to put the 3x2= 6 rows of formulas in my worksheet “MyGuess” or worksheet “MyGuessAfter” is

Code: Select all

Sub DoSomefinkMayBeeGuess()
Dim arrTLBL() As Variant: Let arrTLBL() = Array(6, 35, 39, 68, 72, 91)
Dim Cnt As Long
    For Cnt = 0 To UBound(arrTLBL) Step 2
    Dim MeFormula As String
    ' First Formula row
     Let MeFormula = FuncyFormula(arrTLBL(Cnt + 1) - 1, arrTLBL(Cnt)): Debug.Print "MeFormula for Some first row, " & arrTLBL(Cnt + 1) + 1 & ", is    " & MeFormula
     Let Range("B" & arrTLBL(Cnt + 1) + 1 & ":AF" & arrTLBL(Cnt + 1) + 1 & "").Value = MeFormula
    ' Second Formula row
     Let MeFormula = FuncyFormula(arrTLBL(Cnt + 1), arrTLBL(Cnt) + 1): Debug.Print "MeFormula for Some second row, " & arrTLBL(Cnt + 1) + 2 & ", is    " & MeFormula
     Let Range("B" & arrTLBL(Cnt + 1) + 2 & ":AF" & arrTLBL(Cnt + 1) + 2 & "").Value = MeFormula
    Next Cnt
End Sub
Function FuncyFormula(ByVal BL As Long, ByVal TL As Long) As String
Dim Cnt As Long
    For Cnt = BL To TL Step -2
    Dim MeStrungOut As String
     Let MeStrungOut = ",B" & Cnt & MeStrungOut
    Next Cnt
Let MeStrungOut = Replace(MeStrungOut, ",", "", 1, 1, vbBinaryCompare) 'take off just 1 ","
Let FuncyFormula = "=sum(" & MeStrungOut & ")"
Debug.Print "FuncyFormula is   " & FuncyFormula
End Function
The routine Sub DoSomefinkMayBeeGuess() will make my worksheet “MyGuess “look like my worksheet” MyGuessAfter
Run code Sub DoSomefinkMayBeeGuess() with worksheet “MyGuess “ active, and then you should get an identical worksheet to my worksheet “ MyGuessAfter

_._____________________

I am guessing that you want help to do 2 - 3 things
_1 ) Divide your total output into sections of maximum 30 rows, with 3 new rows between sections
_2) Give the two rows of sum totals in the first two of the 3 new rows.
_3) Possibly you want some final total

Your original file and your original code and explanation in Post #1 and all your attempts in the following posts has totally confused me as to what you are trying to do
I think I know all that you want now, but I am not totally sure


Alan

File "SalaryTBGuess.xlsm" : https://app.box.com/s/4xo0cqcwlu4jlrj9gm1p0cmj61pujfzv" onclick="window.open(this.href);return false;
I am having difficulty logging in with this account just now.
You can find me at DocAElstein also

YasserKhalil
PlatinumLounger
Posts: 4911
Joined: 31 Aug 2016, 09:02

Re: Sum specific rows as even and odd

Post by YasserKhalil »

Thank you very much Mr. Alan for your explanation. Your file 'MyGuessAfter' worksheet is what I am seeking for ...
My code simply brings the data from Salary sheet .. each row will be in tow rows and that's working well with no problems
and in this part of code I am trying to adjust the results

Code: Select all

            If n Mod 30 = 0 Then
                For c = 2 To 32
                    x = 0
                    For r = (n - 30) + 1 To n Step 2
                        x = x + Val(b(r, c))
                    Next r
                    b(n + 1, c) = x
    
                    x = 0
                    For r = (n - 30) + 2 To n Step 2
                        x = x + Val(b(r, c))
                    Next r
                    b(n + 2, c) = x
                Next c
                n = n + 3
            End If
But I couldn't fix it to suit my needs .. and the expected is exactly as you did in 'MyGuessAfter' worksheet .. but I need to do that in the same original code
Thank you very much for great help

User avatar
Doc.AElstein
BronzeLounger
Posts: 1499
Joined: 28 Feb 2015, 13:11
Location: Hof, Bayern, Germany

Re: Sum specific rows as even and odd

Post by Doc.AElstein »

Hi Yasser,
Please give a file with code that just brings in all data from Salary to TB.
In this File, please make also a third worksheet, “Final” to show
_1) how your data will be divided up into sections ,
and
_2) show on the worksheet “Final” exactly what you want. ( To save you some time you can use the formulas from Paul, or my codes to put the formulas in the worksheet “Final”

If no one else does it for you , then I will do it later today.

Alan
I am having difficulty logging in with this account just now.
You can find me at DocAElstein also

YasserKhalil
PlatinumLounger
Posts: 4911
Joined: 31 Aug 2016, 09:02

Re: Sum specific rows as even and odd

Post by YasserKhalil »

Here's a file that just brings all data from Salary worksheet
And as for the final output, you already did in your file in worksheet named 'MyGuessAfter'
You do not have the required permissions to view the files attached to this post.