I want to sum total figure of quantity by checking with blank cell under. like say invoice A have two figure 1 and 2 so the total show 3. many thanks
Logic: Check Inv, if it is blank, sum up Qty. If not, it means we met a new Inv. Therefore, we store the sum into last Total and read data for new Inv.
Private Sub Total()
With ActiveSheet
Dim lastRow As Long
lastRow = .Cells(Rows.Count, 2).End(xlUp).Row
Dim i As Long
Dim sum As Long
Dim firstInvCell As Range
On Error Resume Next
For i = 2 To lastRow
If .Cells(i, 1).Value = "" Then
'Inv is blank, sum up
sum = sum + .Cells(i, 2).Value
Else
'Inv is not blank, means next inv starts from here
firstInvCell.Value = sum
'store the first row of this inv
Set firstInvCell = .Cells(i, 3)
sum = .Cells(i, 2).Value
End If
Next i
firstInvCell.Value = sum
End With
End Sub
A simple VBA sub do-until with will do, something like this
index = 1 ' Initialize row index.
Do Until index > 7 ' Change 7 to .usedrange.Rows.Count / your number of rows.
If Range("A1").Offset(index - 1, 0).Value <> vbNullString Then
sum = Range("B1").Offset(index - 1, 0).Value
position = index + 1
' Do a running sum, until encounter the next non-blank
Do Until Range("A1").Offset(position - 1, 0) <> vbNullString
sum = sum + Range("B1").Offset(position - 1, 0).Value
position = position + 1
If position > 7 Then Exit Do ' Just in case.
Loop
Range("C1").Offset(index - 1, 0).Value = sum
' Reassign pointer
index = position
End If
Loop
Related
I would like populate the blue area with random numbers.
sum of C3 to R3 should be equal to B3 value: 124
also;
sum of C3 to C26 should be equal to C2 value: 705
I tried to achieve it with the following code:
(this code was originally posted here: Code by #Mech
Sub RandomNumbersArray()
' dim your variables. this tells vba what type of variable it is working with
Dim lRow As Long
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Worksheets("SPLIT BY DAYS")
' find the last row in column b (2) in the above defined ws
lRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
' loop through rows 3 to last row
For i = 3 To lRow
' generate a random number between 0 and the row contents of column B (5)
ws.Cells(i, 3).Value = Int(Rnd() * (ws.Cells(i, 2).Value + 1))
' generate a random number between 0 and the difference between column B and colum C
ws.Cells(i, 4).Value = Int(Rnd() * (ws.Cells(i, 2).Value - ws.Cells(i, 3).Value))
' subtract the difference between column B and the sum of column C and column D
ws.Cells(i, 5).Value = ws.Cells(i, 2).Value - (ws.Cells(i, 3).Value + ws.Cells(i, 4).Value)
' subtract the difference between column B and the sum of column C and column D and column E
ws.Cells(i, 6).Value = ws.Cells(i, 2).Value - (ws.Cells(i, 3).Value + ws.Cells(i, 4).Value + ws.Cells(i, 5).Value)
' subtract the difference between column B and the sum of column C and column D and column E and column F
ws.Cells(i, 7).Value = ws.Cells(i, 2).Value - (ws.Cells(i, 3).Value + ws.Cells(i, 4).Value + ws.Cells(i, 5).Value + ws.Cells(i, 6).Value)
Next i
' sum column C (column 3) and place the value in C2
ws.Cells(2, 3).Value = Application.WorksheetFunction.Sum(Range(Cells(3, 3), Cells(lRow, 3)))
' sum column D (column 4) and place the value in D2
ws.Cells(2, 4).Value = Application.WorksheetFunction.Sum(Range(Cells(3, 4), Cells(lRow, 4)))
' sum column E (column 5) and place the value in E2
ws.Cells(2, 5).Value = Application.WorksheetFunction.Sum(Range(Cells(3, 5), Cells(lRow, 5)))
' sum column F (column 6) and place the value in F2
ws.Cells(2, 6).Value = Application.WorksheetFunction.Sum(Range(Cells(3, 6), Cells(lRow, 6)))
' sum column G (column 7) and place the value in F2
ws.Cells(2, 7).Value = Application.WorksheetFunction.Sum(Range(Cells(3, 7), Cells(lRow, 7)))
End Sub
EDIT: Just to clarify, no negative numbers.
Here is something to try:
Set all cells to 0. Create a list of all cells (some kind of reference to each cell).
Now, randomly choose a cell from your list, and add 1 to that cell. The very first time, all cells will be 0, except for one, which will now be 1.
For this cell that you just incremented, add up the row and column and see if the sums have been reached. If either the row or the column sum has been reached, remove this cell reference from the list.
Repeat (randomly choose a cell from those remaining on the list) until the list is empty.
At each iteration you are randomly choosing one of the remaining cells in the reference list (not choosing from all the cells) and this list is getting smaller and smaller as column or row sums are reached.
It should be the case that random cells will increment, and if the columns and sums can in fact be calculated by values without logical inconsistencies, you should fairly quickly reach that point when the reference list falls empty.
I have a solution.
Answers so far have mostly been about finding values which are random, then fixing them to fit the totals.
I tried finding a calculated (non random) solution that fits the totals, then made a separate sub to randomize it. This way you can prevent the randomization from introducing negative values.
There are two procedures, This sub will call them both on the same Range.
Sub Call_Random_Array
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Worksheets("SPLIT BY DAYS")
Dim RangeToFill as Range: Set RangeToFill = ws.Range("C3:R26") 'Edit this line to select whatever range you need to fill randomly
'Proportionately fill the array to fit totals:
Call ProportionateFillArray(RangeToFill)
'Randomize it x times
For x = 1 to 10 'increase this number for more randomisation
Call RandomizeValues(RangeToFill)
Next
End Sub
Proportionately fill the array to fit totals:
Sub ProportionateFillArray(rngAddress As Range)
Dim ws As Worksheet: Set ws = rngAddress.Worksheet
'Horizontal and Vertical target values as ranges:
Dim hTarg As Range, vTarg As Range
Set hTarg = rngAddress.Rows(1).Offset(-1, 0)
Set vTarg = rngAddress.Columns(1).Offset(0, -1)
'Check the totals match
If Not WorksheetFunction.Sum(hTarg) = WorksheetFunction.Sum(vTarg) Then
'totals don't match
MsgBox "Change the targets so both the horizontal and vertical targets add up to the same number."
Exit Sub
End If
With rngAddress
'Now fill rows and columns with integers
Dim Row As Long, Col As Long
For Row = 1 To .Rows.Count
For Col = 1 To .Columns.Count
.Cells(Row, Col) = Int( _
hTarg.Cells(Col) * vTarg.Cells(Row) / WorksheetFunction.Sum(hTarg) _
)
Next
Next
'Correct rounding errors
For Row = 1 To .Rows.Count
For Col = 1 To .Columns.Count
If Row = .Rows.Count Then
'Last row, so this column must be corrected come what may
.Cells(Row, Col) = .Cells(Row, Col) - WorksheetFunction.Sum(.Columns(Col)) + hTarg.Cells(Col)
ElseIf Col = .Columns.Count Then
'Last column, so must be corrected come what may
.Cells(Row, Col) = .Cells(Row, Col) - WorksheetFunction.Sum(.Rows(Row)) + vTarg.Cells(Row)
ElseIf _
(WorksheetFunction.Sum(.Rows(Row)) - vTarg.Cells(Row)) * _
(WorksheetFunction.Sum(.Columns(Col)) - hTarg.Cells(Col)) > 0 Then
'both row and column are incorrect in the same direction
.Cells(Row, Col) = .Cells(Row, Col) - WorksheetFunction.Max( _
WorksheetFunction.Sum(.Rows(Row)) - vTarg.Cells(Row), _
WorksheetFunction.Sum(.Columns(Col)) - hTarg.Cells(Col))
End If
Next
Next
End With
End Sub
Randomize an array without changing row or column totals:
Sub RandomizeValues(rngAddress As Range)
Dim ws As Worksheet: Set ws = rngAddress.Worksheet
Dim rngIncrease(1 To 2) As Range, rngDecrease(1 To 2) As Range, lDiff As Long
With rngAddress
'Select two cells to increase at random
For a = 1 To 2
Set rngIncrease(a) = .Cells(RndIntegerBetween(1, .Rows.Count), RndIntegerBetween(1, .Columns.Count))
rngIncrease(a).Select
Next
'Corresponding cells to decrease to make totals the same:
Set rngDecrease(1) = ws.Cells(rngIncrease(1).Row, rngIncrease(2).Column)
Set rngDecrease(2) = ws.Cells(rngIncrease(2).Row, rngIncrease(1).Column)
'Set the value to increase/decrease by - can't be more than the smallest rngDecrease Value, to prevent negative values
If Not WorksheetFunction.Min(rngDecrease) > 1 Then
'Don't decrease a value below 1
Exit Sub
Else
lDiff = RndIntegerBetween(1, WorksheetFunction.Min(rngDecrease)-1)
End If
'Now apply the edits
For a = 1 To 2
rngIncrease(a) = rngIncrease(a) + lDiff
rngDecrease(a) = rngDecrease(a) - lDiff
Next
End With
End Sub
'The below is the Random Integer function, I also used it in my other answer
Function RndIntegerBetween(Min As Long, Max As Long) As Long
RndIntegerBetween = Int((Max - Min + 1) * Rnd + Min)
End Function
This code is for what you were trying to do, not exactly how you explained it though (see comments). If this is what you were looking for, then your explanation was a bit off, otherwise let me know what you did mean.
Sub RandomNumbersArray()
Dim lRow As Long, lColumn As Long, remainingValue As Long
Dim wb As Workbook: Set wb = ActiveWorkbook
Dim ws As Worksheet: Set ws = wb.Worksheets("SPLIT BY DAYS")
lRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
lColumn = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column
For i = 3 To lRow 'loop through the rows
remainingValue = ws.Cells(i, 2).Value2
For j = 3 To lColumn 'loop through all the columns per row
' generate a random number between 0 and the row contents of column B - previous column
If j = lColumn Then 'last cell can't be random unless you want to extend the columns until the sum in B-column is met
ws.Cells(i, j).Value2 = remainingValue
Else
ws.Cells(i, j).Value2 = Int((remainingValue + 1) * Rnd)
End If
remainingValue = remainingValue - ws.Cells(i, j).Value2
Next j
Next i
For j = 3 To lColumn 'loop through the columns to set the sum
ws.Cells(2, j).Value2 = Application.WorksheetFunction.Sum(Range(Cells(3, j), Cells(lRow, j)))
Next j
End Sub
I'm yet to get past the O-column with any value above 0 however
So I am trying to cumulatively sum down a column until a value is reached, then in the column adjacent to the column with the values, add a text of some sort that indicates where one sum ended and a new one began. Next, I want to restart the sum from where I left off with a value of 0 and keep doing this until there are no more values to sum.
This is what I have but it does not seem to be working properly (It prematurely begins to increment to the next step even though the sum of "~3815" has not been reached:
Private Sub NumberOfTrucks_Click()
Dim j As Integer
Dim i As Integer
'~~> j stands for number of summed segments
j = 1
dbSumTotal = 0
lastrow = Range("AU" & Rows.Count).End(xlUp).Row
For i = 3 To lastrow Step 1
'~~> in column AU are the numbers for the sum
dbSumTotal = dbSumTotal + Cells(i, "AU").Value
'~~> write value to cell and reset sum to 0
If dbSumTotal >= 3815.9999999 Then
dbSumTotal = 0
'~~> for next sum raise the segment number
j = j + 1
End If
Cells(i, "AX") = j
Next i
MsgBox ("Completed")
End Sub
Incremental Sum
A Quick Fix
Private Sub NumberOfTrucks_Click()
Dim LastRow As Long
Dim j As Long
Dim i As Long
Dim dbSumTotal As Double
LastRow = Range("AU" & Rows.Count).End(xlUp).Row
'~~> j stands for number of summed segments
j = 1
For i = 3 To LastRow
'~~> in column AU are the numbers for the sum
dbSumTotal = dbSumTotal + Cells(i, "AU").Value
Cells(i, "AX") = j
' To make it more obvious, uncomment the following line.
'Cells(i, "AY") = dbSumTotal
'~~> write value to cell and reset sum to 0
If dbSumTotal >= 3815.9999999 Then
' 3815.9999999 might be a left over when you were using '>',
' so I think the previous line should be:
'If dbSumTotal >= 3816 Then
dbSumTotal = 0
'~~> for next sum raise the segment number
j = j + 1
End If
Next i
MsgBox ("Completed")
End Sub
Here we are.
You're issue was when you got to the row that was over 3815, you added to j, then wrote to column AX. Now instead, we write to AX then add to j.
Private Sub NumberOfTrucks_Click()
Dim j As Integer
Dim i As Integer
'~~> j stands for number of summed segments
j = 1
dbSumTotal = 0
lastrow = Range("AU" & Rows.Count).End(xlUp).Row
For i = 3 To lastrow Step 1
'~~> in column AU are the numbers for the sum
dbSumTotal = dbSumTotal + Cells(i, "AU").Value
'~~> write value to cell and reset sum to 0
If dbSumTotal >= 3815.9999999 Then
dbSumTotal = 0
Cells(i, "AX") = j
j = j + 1
Else
'~~> for next sum raise the segment number
Cells(i, "AX") = j
End If
Next i
MsgBox ("Completed")
End Sub
I have two columns of data on the same worksheet.
I want to compare all the values in column B to the last value in column A. If they are the same, call a certain function. Then move to the next value in column A, and compare to all values in B again, etc.
Sub FindSamples()
Dim first As String
Dim second As String
Dim j As Long
Dim i As Long
Dim lastRowNumber As Long
Dim lastRowNumberDDH As Long
With Sheets("Shape Point Info")
lastRowNumber = .Cells(Rows.Count, 1).End(xlUp).Row
lastRowNumberDDH = .Cells(Rows.Count, 20).End(xlUp).Row
For i = lastRowNumberDDH To 0 Step -1
For j = lastRowNumber To 0 Step -1
second = Cells(j, 4).Value
first = Cells(i, 20).Value
If first = second Then
'Call something
Worksheets("Shape Point Info").Range("J14").Value = "Yes"
Else:
End If
Next j
Next i
End With
End Sub
My errors are on lines 17 and 18 of my code:
second = Cells(j, 4).Value
first = Cells(i, 20).Value
I get
"Run time error 1004: Application-defined or object-defined error"
Cells, Rows, Columns, and almost all collections and items in VBA are 1-indexed. Therefore you cannot access Rows(0), and this is the issue with your code. You have to amend your For lines as such:
For i = lastRowNumberDDH To 1 Step -1
For j = lastRowNumber 1 Step -1
My code mostly works but it's taking a while to debug so I am beginning to think my architecture may be flawed XD So how can I architect this better?
I have groups of data separated by a blank row. You can tell each group apart by the ID in column C in addition to the blank row. For each ID, I have various numbers in column B that I need to capture. Sometimes those numbers only start with 5, sometimes it starts with 7. I need to capture the 5 and the 7 separately.
With projWS
With .Range("C1:C6000")
Set f = .Find(cc, LookIn:=xlValues, lookat:=xlPart)
End With
If Not f Is Nothing Then 'first occurence found
counter = 0
i = f.Row
Do
acct = .Cells(i, 2)
If (Len(projWS.Cells(i, 3)) < 1 Or Left(acct, 1) = "7") And done = False Then
acctStart = f.Row
acctRows = i - acctStart
Set acctRng = .Range(.Cells(acctStart, 2), .Cells(i - 1, 5))
Set amountRng = .Range(.Cells(acctStart, 7), .Cells(i - 1, 8))
done = True 'set flag to show range has been filled
End If
counter = counter + 1 'increment counter
i = i + 1 'move to next row
Loop Until Len(.Cells(i, 3)) < 1 'keep looping until blank row
End If
If counter - 1 > acctRows Then 'how we determine if there's a "7"
flag = True 'so we set flag to true
Set depreRng = Range(.Cells(acctStart + acctRows, 2), .Cells(i - 1, 8))
dep = depreRng.Value2 'store range into array
End If
End With
After capture, I need to drop it into another worksheet. This worksheet already has a block of 7 built in. Hence this is the loop I am using to drop the range of 7. There is no built in block for the 5.
For r = 112 To 120
For k = 1 To UBound(dep())
If .Cells(r, 1).Value2 = Trim(dep(k, 1)) Then
Debug.Print .Cells(r, 1).Value2
.Cells(r, 6) = dep(k, 6)
.Cells(r, 7) = dep(k, 7)
Exit For
Else
.Cells(r, 6) = 0
.Cells(r, 7) = 0
End If
Next k
Next r
I have debugged several errors already. The current one is that depreRng is breaking because my math is bad. Instead of debugging each error as I stumble onto it, how can I architect this better?
Ok, my approach it's different. First i use a filter for find the range of rows with the index you are looking for and then loop inside this filtered rows for find the 5xx and the 7xx range. The code:
Sub Macro1()
Dim rng_5xx_start, rng_5xx_stop, rng_7xx_start, rng_7xx_stop As Integer
rng_5xx_start = 0
rng_5xx_stop = 0
rng_7xx_start = 0
rng_7xx_stop = 0
Dim range_5xx, range_7xx As String
'filter for the index you are looking for
'specify the maximum range, the field is the "offset" from the column B (the firts of the range), so for filter for column C you need to put 2, criteria...is the critera :)
ActiveSheet.Range("$B$1:$H$6000").AutoFilter Field:=2, Criteria1:="b"
'the filter returns only the rows with the specifyed index, now a for inside this rows for find the 5xx and the 7xx sub-ranges
For Each Row In ActiveSheet.Range("b1:b6000").SpecialCells(xlCellTypeVisible)
If Cells(Row.Row, 2).Value > 4999 And Cells(Row.Row, 2).Value < 6000 Then
'or any test for understnd if i'm in the 5xx range, if you prefer use the strings use something like left(cells(row.row,2).value,1) = "5"
If rng_5xx_start = 0 Then 'found the first row with a 5xx value
rng_5xx_start = Row.Row 'set the start of the range to this row
End If
If rng_5xx_stop < Row.Row Then 'the row where i am is in the 5xx range and is grater than the current end i noticed
rng_5xx_stop = Row.Row 'refresh the end of the range...at the end this will have the last number of row of the 5xx range
End If
End If
If Cells(Row.Row, 2).Value > 6999 And Cells(Row.Row, 2).Value < 8000 Then
'same as above but for 7xx range
If rng_7xx_start = 0 Then
rng_7xx_start = Row.Row
End If
If rng_7xx_stop < Row.Row Then
rng_7xx_stop = Row.Row
End If
End If
Next
If rng_5xx_start = 0 Then
'not found 5xx rows
range_5xx = "" 'or False, or what you prefer...
Else
range_5xx = "B" & rng_5xx_start & ":H" & rng_5xx_stop
End If
If rng_7xx_start = 0 Then
'not found 7xx rows
range_7xx = "" 'or False, or what you prefer...
Else
range_7xx = "B" & rng_7xx_start & ":H" & rng_7xx_stop
End If
End Sub
That's how i would imagine a macro for your job ;)
Edit 1:
I forgot that this will leave the sheet with the filter on...use activesheet.showalldata for show all the rows and not only the filtered ones
Edit 2:
The tests
If rng_5xx_stop < Row.Row Then
rng_5xx_stop = Row.Row
End If
and
If rng_7xx_stop < Row.Row Then
rng_7xx_stop = Row.Row
End If
are not necessary, it's enough do rng_5xx_stop = Row.Row and rng_7xx_stop = Row.Row and save the two IF statements
You are grouping cells based on the first number of the cell values in column B (I am assuming that they can never be letters). If that is the case, then you can create an array of 0 to 9 and store your ranges in there. Then go through the range.areas in order to get the groupings you're looking for (as highlighted in your screenshot).
To do this, something like this is all you need. I commented code to try to explain it more:
Sub tgr()
Dim wsData As Worksheet
Dim rColB As Range
Dim BCell As Range
Dim aRanges(0 To 9) As Range
Dim SubGroup As Range
Dim lRangeNum As Long
Dim i As Long
'Change to your actual worksheet
Set wsData = ActiveWorkbook.ActiveSheet
'Change to your actual column range, this is based off the sample data
Set rColB = wsData.Range("B1", wsData.Cells(wsData.Rows.Count, "B").End(xlUp))
'Loop through the column range
For Each BCell In rColB.Cells
'Make sure the cell is populated and the starting character is numeric
If Len(BCell.Value) > 0 And IsNumeric(Left(BCell.Value, 1)) Then
'Get the starting digit
lRangeNum = Val(Left(BCell.Value, 1))
'Check if any ranges have been assigned to that array index location
'If not, start a range at that array index
'If so, combine the ranges with Union
Select Case (aRanges(lRangeNum) Is Nothing)
Case True: Set aRanges(lRangeNum) = BCell
Case Else: Set aRanges(lRangeNum) = Union(aRanges(lRangeNum), BCell)
End Select
End If
Next BCell
'You can use any method you want to access the ranges, this just loops
'through the array indices and displays the range areas of each
For i = 0 To 9
If Not aRanges(i) Is Nothing Then
For Each SubGroup In aRanges(i).Areas
'Do what you want with it here
'This just selects the subgroup so you can see it found the groups properly
SubGroup.Select
MsgBox SubGroup.Address
Next SubGroup
End If
Next i
End Sub
I see you've allready rewritten your code, but I'd like to offer how I would do it and would like to know your thoughts about it. Would this be inefficient? I guess it could be because you have to read the first character in cells 4 times for every increment, but not shure if that is a big problem.
Dim start_row As Long
Dim end_row As Long
start_row = 1
end_row = 0
For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
If Cells(i - 1, 2) = "" Then
start_row = i
ElseIf Left(Cells(i - 1, 2), 1) <> Left(Cells(i, 2), 1) Then
start_row = i
End If
If Cells(i + 1, 2) = "" Then
end_row = i
ElseIf Left(Cells(i + 1, 2), 1) <> Left(Cells(i, 2), 1) Then
end_row = i
End If
If end_row <> 0 Then
Call copy_range(start_row, end_row)
end_row = 0
End If
Next i
Another approach that lets you only read the character once could be
Dim start_row As Long
Dim end_row As Long
Dim char_above As String
Dim this_char As String
start_row = 1
end_row = 1
For i = 1 To Range("B" & Rows.Count).End(xlUp).Row
If Cells(i, 2) = "" Then
end_row = i - 1
if i <>1 then Call copy_range(start_row, end_row,char_above)
start_row = i + 1
Else
this_char = Left(Cells(i, 2), 1)
If this_char <> char_above Then
end_row = i - 1
if i<> 1 then Call copy_range(start_row, end_row,char_above)
start_row = i
End If
char_above = this_char
End If
Next i
Let me know your thoughts.
i'm a complete noob in vba so i'm searching all over the net to combine the code but right now it seems i hit the great wall and can't get it right. what i wanna do are:
to sum every row above and add extra row above (somehow i get this
right)
in extra row (i said above) i want to count every cells above that have value more than zero (in excel i use simple count if formula but i cant do it in vba)
to loop the step above in another sheet in this workbook except sheet 1 (the quantity of sheets can vary depend on the input, so i believe this can be done by loop but i dont know how)
to copy the output of the step above into sheet 1
this is my code so far and since i cant do loop i did it manualy for sheet2 and sheet3. i get stuck in step 2
here is the code that've been modified taken from #NEOman' code
Sub Copy_Sum()
Dim ws As Worksheet
'Selecting the worksheets to loop through
K = 1
For Each ws In ThisWorkbook.Worksheets
'Skiping the sheet1
If ws.Name <> "Sheet1" Then
'Counting the number of rows for automation
rowscount = Cells(Rows.Count, 1).End(xlUp).Row
temp = 0
'Looping throught the cells for the calculation
For j = 2 To (rowscount)
'Counting the number of cells which value greater than zero
If Cells(j, 9) > 0 Then
temp = temp + 1
End If
Next j
'Counting the number of rows for automation
rowscount1 = Cells(Rows.Count, 1).End(xlUp).Row
temp1 = 0
For i = 2 To (rowscount1)
'Counting the number of cells which value greater than zero
If Cells(i, 10) > 0 Then
temp1 = temp1 + 1
End If
Next i
'Summing up the values which are above the current cell and in Sheet1, this inclues negative numbers as well
Cells(rowscount + 1, 9).Value = Application.Sum(Range(Cells(1, 9), Cells(rowscount, 9)))
Cells(rowscount + 2, 9) = temp
'copy ke sheet 1
Worksheets("Sheet1").Cells(K, 1).Value = Cells(rowscount + 1, 1).Value
Worksheets("Sheet1").Cells(K, 2).Value = temp
K = K + 1
Cells(rowscount1 + 1, 10).Value = Application.Sum(Range(Cells(1, 10), Cells(rowscount1, 10)))
Cells(rowscount1 + 2, 10) = temp1
'copy ke sheet 1
Worksheets("Sheet1").Cells(rowscount1 + K, rowscount1 + 1).Value = Cells(rowscount1 + 2, 1).Value
Worksheets("Sheet1").Cells(rowscount1 + K, rowscount1 + 2).Value = temp1
K = K + 1
End If
Next ws
End Sub
i know my code is a mess and i wrote comment in every step i did so that i know what the codes are doing. i use different code for column I and J but neither works :(. any help will be appreciated, thanks in advance for your attention.
===========================================================================================
the code must be run in every sheet (except sheet1) manualy, so im still trying to make the code run from sheet1 but work on any other sheet in same workbook. any help will be appreciated, thanks in advance for your attention.
Sub Copy_Sum()
Dim ws As Worksheet
'Selecting the worksheets to loop through
K = 1
For Each ws In ThisWorkbook.Worksheets
'Skiping the sheet1
If ws.Name <> "Sheet1" Then
'Counting the number of rows for automation
rowsCount = Cells(Rows.Count, 1).End(xlUp).Row
temp = 0
'Looping throught the cells for the calculation
For j = 2 To (rowsCount)
'Counting the number of cells which value greater than zero
If Cells(j - 1, 1) > 0 Then
temp = temp + 1
End If
Next j
'Summing up the values which are above the current cell and in Sheet1, this inclues negative numbers as well
Cells(rowsCount + 1, 1).Value = Application.Sum(Range(Cells(1, 1), Cells(rowsCount, 1)))
Cells(rowsCount + 1, 2) = temp
Worksheets("Sheet1").Cells(K, 1).Value = Cells(rowsCount + 1, 1).Value
Worksheets("Sheet1").Cells(K, 2).Value = temp
K = K + 1
End If
Next ws
End Sub