I am trying to create loop which is summing numbers in column N until certain value is reach then write something to cell M.
I have this code working but what I actualy need is to after it found the set value to go to next row and start from 0 untill it finds again the value and then again go to next line and sum from 0 to some value.
Example of data
INV SIZE of INV
26530492 1
26530520 1
26530521 1
26530523 1
26530527 1
26530528 1
26531080 1
26531083 1
26531112 1
26531114 1
26543723 1
26543737 1
26556566 1
26556893 1
in first column are invoices and second column is showing size of the file. The loop would go throug Size column and sum rows until value is reached like 5, then it will continue until another value is reached and so on...it will also add condition to new column like first sum is number 1, second sum 2, etc..
also I am playing with code below
Sub Sum_loop()
'~~> j stands for number of summed segment
j = 1
dbSumTotal = 0
lastrow = Range("N" & Rows.count).End(xlUp).Row
For i = 2 To lastrow Step 1
'~~> in column N are numbers for sum
dbSumTotal = dbSumTotal + Cells(i, "N")
If (dbSumTotal >= 3 Or dbSumTotal <= 3) Then
Cells(i, "O") = j
'~~> reset sum to 0
If dbSumTotal >= 3 Then
dbSumTotal = 0
'~~> for next sum raise the segment number
j = j + 1
End if
End If
Next i
End Sub
Your logic is messed up. The first if statement can never be true. Remove it completely and write the cell value after the counter is incremented.
Sub Sum_loop()
'~~> j stands for number of summed segment
j = 1
dbSumTotal = 0
lastrow = Range("N" & Rows.count).End(xlUp).Row
For i = 2 To lastrow Step 1
'~~> in column N are numbers for sum
dbSumTotal = dbSumTotal + Cells(i, "N")
'~~> write value to cell and reset sum to 0
If dbSumTotal >= 3 Then
dbSumTotal = 0
'~~> for next sum raise the segment number
j = j + 1
End If
Cells(i, "O") = j
Next i
End Sub
Related
Is there a way in VBA to add a "Z" next to 3 x's within the example below? The cell must be blank after the 3 x's. (Just like the first ID and April below)
Adding to the accepted code in the answer to your previous question:
Sub sub1()
Dim irow&, icol&, n&
For irow = 2 To 6 ' rows
n = 0
For icol = 2 To 14 ' columns
If Cells(irow, icol) = "" Then
n = n + 1
If n <= 3 Then
Cells(irow, icol) = "x"
ElseIf n = 4 Then
Cells(irow, icol) = "z"
End If
Else
n = 0
End If
Next
Next
End Sub
I am trying to write in VBA a macro that searches a zero in column A, compares it to the cell in the same row but in column B, and if both are zero, and in the next row both columns are zero as well, the macro displays the first row where it found the first zero and the last consecutive row in which the last zero was.
I am currently writing it with a For each loop, searching in Column A and comparing with column B, but I have no idea on how to make it so that it continues searching until the column ends. I have to note that there could be more than one range with consecutive zeroes, therefore I imagine I need an array that stores the ranges, or at least the row numbers.
Sub BuscaMargenCero()
'
'
'
Dim ini() As Variant
Dim fin() As Variant
Dim UltimaFila As Long
Dim cell As Range
Dim i As Integer
Dim j As Integer
Dim flag As Integer
With Sheets("CĂLCULO Margen")
UltimaFila = .Range("B" & .Rows.Count).End(xlUp).Row - 1
i = 1
j = 1
flag = 0
For Each cell In Range("B2:B" & UltimaFila)
If cell = 0 And .Cells(cell.Row + 1, 6).Value = 0 Then
If flag = 0 And (.Cells(cell.Row + 1, 2).Value = 0 And .Cells(cell.Row + 1, 6).Value = 0) Then
ini(i) = cell.Row
i = i + 1
flag = 1
ElseIf flag = 1 And (.Cells(cell.Row + 1, 2).Value <> 0 Or .Cells(cell.Row + 1, 6).Value <> 0) Then
fin(j) = cell.Row
j = j + 1
flag = 0
End If
End If
Next
End With
End Sub
I am not using Range.Find since I have read it only retrieves the first value found, and I want it to continue searching for more zeroes.
EDIT: To clarify my question, here's how the application should work
A B
2 5
0 1
0 0
0 0
0 0
12 20
The output array should contain the range (in row numbers) 3 - 5
.Autofiter on zeroes for each column. The first and last or each 'set' will be the first and last of each .Area within SpecialCells(xlcelltypevisible).
.AutoFilter requires a header row.
col A col B
2 5
0 1
0 0
0 0
0 0
12 20
0 0
0 0
12 20
Module code:
Sub Macro2()
Dim a As Long, rws As Variant
With Worksheets("sheet4")
if .autofiltermode then .autofiltermode = false
With .Range(.Cells(1, "A"), .Cells(.Rows.Count, "B").End(xlUp))
.AutoFilter field:=1, Criteria1:=0
.AutoFilter field:=2, Criteria1:=0
With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)
If CBool(Application.Subtotal(103, .Cells)) Then
With .SpecialCells(xlCellTypeVisible)
ReDim rws(1 To .Areas.Count, 1 To 2)
For a = LBound(rws, 1) To UBound(rws, 1)
With .Areas(a)
rws(a, 1) = .Cells(1).Row
rws(a, 2) = .Cells(.Cells.Count).Row
End With
Next a
End With
End If
End With
End With
if .autofiltermode then .autofiltermode = false
End With
For a = LBound(rws) To UBound(rws)
Debug.Print rws(a, 1) & " to " & rws(a, 2)
Next a
End Sub
Immediate window results:
4 to 6
8 to 9
I have a spreadsheet where sales data is interspersed with other data in columns N:AD. The column headings for sales always end with the word Sales (e.g., "2015-06-Sales". I would like the data to sum for each row only when the heading ends in the word "Sales". I need to do this with vba because the column names will vary over time.
Example data (I want column F to sum the columns that end in sales - or N and P in the case below):
Column F Column N Column O Column P
Total Sales 2015-05-Sales 2015-05-Qty 2015-01-Sales
Item1 20 5 30 15
Item2 15 5 1 10
Item3 10 1 2 9
Here is the code I have so far:
Sub test()
Dim lcolumn As Long
Dim lrow As Long
Dim SSold
For lrow = 2 To 100 Step 1
For lcolumn = 14 To 30 Step 1
If Right(ws.Range(1 & lcolumn), 5).Value = "Sales" Then
SSold = 0
SSold = SSold + Range(lrow & lcolumn)
End If
Next lcolumn
Range(lrow & 6).Value = SSold
Next lrow
End Sub
It creates Run time error '1004': Method 'Range' of object '_Global' failed on the line that starts "If right(range...
I appreciate any help!
Try this instead:
Sub SumSales()
Dim total As Double
For iRow = 2 To 100 'no need of Step 1, test as many rows as you wish
total = 0 'resets the total for each row
For iCol = 14 To 30 'tests as many columns as you wish
If Right(Cells(1, iCol).Value, 5) = "Sales" Then
total = total + Cells(iRow, iCol).Value
End If
Next iCol 'this loop will go on for each column in iRow row
Cells(iRow, 6).Value = total 'store the total before going to the next row
Next iRow
End Sub
Range takes "A2" style range definitions. Range(Column, Row)
If Right(ws.Range("A" & lrow), 5).Value = "Sales" Then
Try cells if you need to use a number. Cells(row, column)
If Right(ws.Cells(1 & lcolumn), 5).Value = "Sales" Then
I think what I'm trying to do is pretty basic, but I'm brand new to VBA so I'm getting stuck and the answers I've found are close, but not quite right.
I have a list of row entries, like this:
1 4 32 2 4
2 6 33 1 3
1 4 32 2 4
4 2 30 1 5
Notice that rows 1 and 3 are duplicates. I'd like to only have a single instance of each unique row but I don't want to just delete the duplicates, I want to report how many of each type there are. Each row represents an inventory item, so deleting duplicate entries without indicating total quantity would be very bad!
So, my desired output would look something like this, where the additional 6th column counts the total number of instances of each item:
1 4 32 2 4 2
2 6 33 1 3 1
4 2 30 1 5 1
My data sets are larger than just these 5 columns, they're closer to 10 or so, so I'd like to put that last column at the end, rather than to hardcode it to the 6th column (i.e., column "F")
Update:
I found some code that worked with minor tweaking, and it worked this morning, but after messing around with some other macros, when I came back to this one it was telling me that I have a "compile error, wrong number of arguments or invalid property assignment" and it seemed to be unhappy with the "range". Why would working code stop working?
Sub mcrCombineAndScrubDups2()
For Each a In range("A1", Cells(Rows.Count, "A").End(xlUp))
For r = 1 To Cells(Rows.Count, "A").End(xlUp).Row - a.Row
If a = a.Offset(r, 0) And a.Offset(0, 1) = a.Offset(r, 1) And a.Offset(0, 2) = a.Offset(r, 2) Then
a.Offset(0, 4) = a.Offset(0, 4) + a.Offset(r, 4)
a.Offset(r, 0).EntireRow.Delete
r = r - 1
End If
Next r
Next a
End Sub
Assuming that your data starts from A1 on a worksheet named ws1, the following code removes the duplicated rows. Not by shifting the whole table but deleting the entire row.
Sub deletedupe()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim row1 As String
Dim row2 As String
i = 1
j = 1
k = 1
Do While Sheets("ws1").Cells(i, 1).Value <> ""
row1 = ""
j = 1
Do While Sheets("ws1").Cells(i, j).Value <> ""
row1 = row1 & Sheets("ws1").Cells(i, j).Value & " "
j = j + 1
Loop
k = i + 1
Do While Sheets("ws1").Cells(k, 1).Value <> ""
row2 = ""
j = 1
Do While Sheets("ws1").Cells(k, j).Value <> ""
row2 = row2 & Sheets("ws1").Cells(k, j).Value & " "
j = j + 1
Loop
If row1 = row2 Then
Sheets("ws1").Rows(k).EntireRow.Delete
Else
k = k + 1
End If
Loop
i = i + 1
Loop
End Sub
I have a workbook that has thousands of defined name regions located in various worksheets. I'm trying to extract them all and line them up in another workbook.
Most of the defined name regions are 1 row tall (and hundreds of cols wide)... but a few are 3-4 rows tall.
So for example,
Name1
10 5 10 12 30 10 12 10 5 10 12 30 10 12 ...
Name2
10 11 10 12 30 10 12 10 11 10 12 30 10 12 ...
10 11 10 12 30 10 12 10 11 10 12 30 10 12 ...
10 11 10 12 30 10 12 10 11 10 12 30 10 12 ...
For instances where the region is more than one row tall, I'd like to collapse it to a single row by taking the SUM of the entire column.
So Name2 would be copied to the new workbook as the following:
30 33 30 36 90 30 36 30 33 30 36 90 30 36
I have some VBA/VBS written that works perfectly (and fast!) for cases where the region is 1 row tall, but I'm not sure how to handle summing the taller regions in an efficient way.
What's the best way to fill in the question marks below?
My code so far hasn't had to explicitly loop through the cells of a region; I'm hoping that that won't be the case here either. Any advice appreciated!
Dim irow
irow = 0
Dim colsum
'rem Loop through all names and copy over the valid ones
For Each nm in wbSource.Names
'rem Dont copy any name that isnt visible
If nm.Visible = True Then
'rem Only copy valid references that start with "ByWeek"
If InStr(1, nm.RefersTo, "#REF") = 0 And InStr(1, nm.Name, "ByWeek") > 0 Then
'rem Only copy if the range is one row tall
If nm.RefersToRange.Row.Count = 1 Then
wsDest.Range("A3").Offset(irow, 0).Value = nm.Name
wsDest.Range("A3",wsDest.Cells(3,nm.RefersToRange.Columns.Count+1)).Offset(irow, 1).Value = nm.RefersToRange.Value
irow = irow + 1
' rem If the named region is several rows tall, then squish it into one row by taking SUM of each column
elseif nm.RefersToRange.Row.Count > 1 Then
wsDest.Range("A3").Offset(irow, 0).Value = nm.Name
???????????????????????????????????
irow = irow + 1
End If
End If
End if
Next
You can update your code such that it adds all the cells in the given range (nm.RefersToRange), independently upon the number of cells:
Dim irow
irow = 0
'rem Loop through all names and copy over the valid ones
For Each nm in wbSource.Names
'rem Dont copy any name that isnt visible
If nm.Visible = True Then
'rem Only copy valid references that start with "ByWeek"
If InStr(1, nm.RefersTo, "#REF") = 0 And InStr(1, nm.Name, "ByWeek") > 0 Then
If nm.RefersToRange.Rows.Count >= 1 Then
wsDest.Range("A3").Offset(irow, 0).Value = nm.Name
Dim totVal As Long: totVal = 0 'I assumed that target values are Long; update this to the proper type is required
For Each cell In nm.RefersToRange.Cells
If (IsNumeric(cell.Value)) Then totVal = totVal + cell.Value
Next
wsDest.Range("A3", wsDest.Cells(3, nm.RefersToRange.Columns.Count + 1)).Offset(irow, 1).Value = totVal
irow = irow + 1
End If
End If
End if
Next
there is no best way as everyone might think their way is the best.
I would suggest using arrays instead of working with the range objects directly as arrays would have been much faster.
Consider
Now running the code
Option Explicit
Sub Main()
Dim lastRow As Long
Dim lastCol As Long
lastRow = Range("A" & Rows.Count).End(xlUp).Row
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
Dim arr As Variant
arr = Range(Cells(1, 1), Cells(lastRow, lastCol))
ReDim sumArr(UBound(arr, 2)) As Variant
Dim i As Long
Dim j As Long
Dim colSum As Long
For i = LBound(arr, 1) To UBound(arr, 2)
For j = LBound(arr, 1) To UBound(arr, 1)
colSum = colSum + arr(j, i)
Next j
sumArr(i) = colSum
colSum = 0
Next i
ReDim finalArray(UBound(sumArr) - 1) As Variant
For i = 1 To UBound(sumArr)
finalArray(i - 1) = sumArr(i)
Next i
Range("A10").Resize(1, UBound(finalArray, 1) + 1) = finalArray
End Sub
Results in
The idea to use arrays is taken from here
And all you need to do is modify the range you want to reprint the array to
Range("A10").Resize(1, UBound(finalArray, 1) + 1) = finalArray
So if you use the above code I think all you'll need to change will be
wsDest.Range("A3").Resize(1, UBound(finalArray, 1) + 1) = finalArray
Here's the code I ended using: It loops through each column for the defined named range. It isn't fast, but it works well enough, as 90% of my ranges are just one row tall.
I've just inserted this code where where it says ????...???? in my question above, :
For j = 1 To nm.RefersToRange.Columns.Count
colsum = 0
For i = 1 To nm.RefersToRange.Rows.Count
If IsNumeric(nm.RefersToRange.Cells(i, j).Value) Then
colsum = colsum + nm.RefersToRange.Cells(i, j).Value
End If
Next
wsDest.Range("A3").Offset(irow, j).Value = colsum
Next