I am fairly new to VBA so what I am trying to do feels almost impossible.
I have an excel sheet with three columns showing the percentage of toner left.
Black Cyan Magenta Yellow
6 45 67 100
93 93 5 19
20 40 65 57
I want to know if it's possible to create a macro to look at all three columns per row and if all the values are higher than 10, to delete the row and if any of the 3 values is below 10 to keep the row and move on to the next one.
In this case, row 2 and 3 would be kept because there's values below 10 but row 4 would be deleted.
For i = Sheet.Cells(Rows.Count, "A").End(xlUp).Row to 2 Step -1
If Cells(i, Column1).Value2 > 10 And Cells(i, Column2).Value2 > 10 And Cells(i, Column3).Value2 > 10 Then
Rows(i).Delete
End If
Next i
Related
I am using an excel array function to select a range and apply formula based on reference cells. But, everytime i add or remove a values, i am able to copy paste the references using macro but the array formula is not updating the range to reselect the new range.
Here is my main table on top and bottom table what i want sing an array formula which i already achieved but when updating using vba its not taking new entries added/deleted by updating the range in the formula.
No. Name V1 V3 V3 V4
1 Wood 10 10 10 10
2 wood 28 28 28 28
3 tree 30 45 60 68
4 plastic 50 50 50 50
5 tree 50 50 50 50
6 iron 64 75 75 80
No. Name V1 V3 V3 V4
1 Wood - A 25 25 25 25
2 Wood - A 50 50 50 50
3 tree - A 50 50 75 75
4 plastic - A 75 75 75 75
5 tree - A 75 75 75 75
6 iron - A 75 100 100 100
First formula: Name column
=concatenate(A1:A6," - A")
Ctrl+shift+enter - is giving me what i need in right table names column.
Second formula: values change
=value(if(C1:F6<25,"25",if(C1:F6<50,"50",if(C1:F6<75,"75","100"))))
This formula i used to assign actual values and the values in left table is forecast values. I can achieve this even using array "ctrl+shift+enter".
Problem:
But the problem, is everytime i update a sheet by adding new entries like A7,A8,A9 while applying the formula using vba it's not taking the new range as A1:A9(A1:A6) for first formula and C1:F9(C1:C6) for second formula but taking the old ranges in brackets. Because, of which i am getting errors like #N/A as its not taking new range, so formula couldn't understand what is in the remaining cells.
Start with:
Put this in the worksheet's code sheet.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A:F")) Is Nothing Then
On Error GoTo meh
Application.EnableEvents = False
Dim t As Range, tr As Long, v As Long
For Each t In Intersect(Target, Range("A:F"))
tr = t.Row
If Cells(tr, "B").Value2 <> vbNullString And _
Application.Count(Range(Cells(tr, "A"), Cells(tr, "F"))) = 5 Then
Cells(tr, "A").Offset(0, 7) = Cells(tr, "A").Value
Cells(tr, "B").Offset(0, 7) = Cells(tr, "B").Value & " - A"
For v = 3 To 6
Select Case Cells(tr, v).Value
Case Is < 25
Cells(tr, v).Offset(0, 7) = 25
Case Is < 50
Cells(tr, v).Offset(0, 7) = 50
Case Is < 75
Cells(tr, v).Offset(0, 7) = 75
Case Else
Cells(tr, v).Offset(0, 7) = 100
End Select
Next v
End If
Next t
End If
meh:
Application.EnableEvents = True
End Sub
Result after adding two rows.
Let's assume we have the following:
A
1 10
2 20
3 30
4 20
5 10
6 30
7 20
8
9
10 =(AVERAGE(A1:A7)
11 4
12 6
I would like to be able to find a way to calculate the Average of A1-A7 into cell A10 while excluding row range defined in A11 and A12. That is, according to the above setup the result should be 20:
((10 + 20 + 30 + 20) / 4) = 20
because if rows 4,5 and 6 are excluded what's left is rows 1,2,3,7 to be averaged.
Two other options:
=AVERAGE(FILTER(A1:A7,ISNA(MATCH(ROW(A1:A7),A11:A12,0))))
=ArrayFormula(AVERAGEIF(MATCH(ROW(A1:A7),A11:A12,0),NA(),A1:A7))
Seems to meet your requirement, though not flexible:
=(sum(A1:A7)-indirect("A"&A11)-indirect("A"&A12))/(count(A1:A7)-2)
Adjust re misunderstanding of requirements:
=(SUM(A1:A7)-SUM(INDIRECT("A"&A11&":A"&A12)))/(COUNT(A1:A7)-A12+A11-1)
I want to sort rows in a decreasing order "until hitting every blank row."
I have the following code:
For j = 1 To 15
For i = 1 To 15
Do Until mySheet.Cells(i, 1).Value = 0
If mySheet.Cells(j, 2).Value > mySheet.Cells(i, 2).Value Then
For c = 2 To 5
temp1 = mySheet.Cells(i, c).Value
mySheet.Cells(i, c).Value = mySheet.Cells(j, c).Value
mySheet.Cells(j, c).Value = temp1
Next c
End If
i = i + 1
Loop
Next i
Next j
The If statement swaps the rows in decreasing order by comparing the 2nd number of the row.
What went wrong is the Do Until Loop. I'd like to keep checking/swapping the rows until it hits a blank row, but continue to check/swapping for the rows after a blank row. Check, swap, stop when hitting a blank row, then check the next rows again, swap again, so on and so forth.
EDIT
Here is a what's what I am trying to do:
BEFORE:
Row B C D E
1 63743 734 1848 246
2 86208 900 900 974
3 --------**Empty Row**----------
4 40934 730 5643 5565
5 97734 454 54656 3345
6 73885 347 3728 9934
7 --------**Empty Row**----------
8 34355 998 3884 3299
9 98438 383 43483 4399
10 19874 454 53439 3499
11 --------**Empty Row**----------
AFTER:
Row B C D E
1 86208 900 900 974
2 63743 734 1848 246
3 --------**Empty Row**----------
4 97734 454 54656 3345
5 73885 347 3728 9934
6 40934 730 5643 5565
7 --------**Empty Row**----------
8 98438 383 43483 4399
9 34355 998 3884 3299
10 19874 454 53439 3499
11 --------**Empty Row**----------
My If compares the values in Column B, and sorts rows in a decreasing order. I could not figure out how to make a while loop so to stop sorting when hitting a blank row, but then continue comparing/sorting for the next couple rows after a blank row. Note I would not know how many rows there are before a blank row.
EDIT 2
BEFORE:
Row A B C D E
1 A 63743 734 1848 246
2 B 86208 900 900 974
3 -------------**Empty Row**----------
4 C 40934 730 5643 5565
5 D 97734 454 54656 3345
6 E 73885 347 3728 9934
7 -------------**Empty Row**----------
8 F 34355 998 3884 3299
9 G 98438 383 43483 4399
10 H 19874 454 53439 3499
11 -------------**Empty Row**----------
AFTER:
Row A B C D E
1 B 86208 900 900 974
2 A 63743 734 1848 246
3 -------------**Empty Row**----------
4 D 97734 454 54656 3345
5 E 73885 347 3728 9934
6 C 40934 730 5643 5565
7 -------------**Empty Row**----------
8 G 98438 383 43483 4399
9 F 34355 998 3884 3299
10 H 19874 454 53439 3499
11 -------------**Empty Row**----------
The code as it stands can never terminate, because the variable you are checking,
Do Until mySheet.Cells(i, 1).Value = 0
if not changed in any of what follows:
If mySheet.Cells(j, 2).Value > mySheet.Cells(i, 2).Value Then
For c = 2 To 5
temp1 = mySheet.Cells(i, c).Value
mySheet.Cells(i, c).Value = mySheet.Cells(j, c).Value
mySheet.Cells(j, c).Value = temp1
Next c
End If
You loop your c from 2 to 5, so Cells(i,1) is never touched.
This is so fundamental that it's a little bit hard to understand what you were really trying to do, but I'll have a shot at it.
It seems that you want each of columns 2 to 5 (maybe 1 to 5) to be sorted with a bubble sort - check two adjacent cells, move the smaller one to the top, keep going to the bottom of the column. You don't state whether each column has the same length, so I am going to assume it doesn't.
We should be able to sort one column at a time as follows (this is not the most efficient algorithm but it's true to your intention, I think):
Sub sortMyColumns()
Dim colNum As Integer
Dim numRows As Integer
Dim i, j As Integer
Dim lastCell As Range
For colNum = 1 To 5
Set lastCell = Cells(1, colNum).End(xlDown)
numRows = lastCell.Row
For i = 2 To numRows
For j = numRows To i Step -1
If Cells(j, colNum) < Cells(j - 1, colNum) Then
temp = Cells(j - 1, colNum).Value
Cells(j - 1, colNum).Value = Cells(j, colNum).Value
Cells(j, colNum).Value = temp
End If
Next j
Next i
Next colNum
End Sub
For each column, this finds the number of rows; it then starts at the bottom, and pushes the smaller number all the way to the top. It returns to the bottom, but this time only pushes up to one from the top. It continues until it gets to the last two cells - everything should now be sorted.
You may need to add some error trapping in case cells do not contain numerical values etc, but in principle this should work.
EDIT
Based on your comment, this was not what you were looking for. I have created a second Sub which sorts columns B through E based just on the value in B - this mirrors your code example a little better, and may be what you had in mind. I am using the length of column B to find out how many rows to sort - I still don't understand clearly what your column A is doing and how testing it helps you.
If this is still not what you want, I suggest you edit your question with a simple example (screen shot) of the type "this is what my sheet starts out with", and "this is what it has to look like". Just four or five lines of the spreadsheet, and columns A through E, should be sufficient.
Sub sortByColumnB()
' sort cells in columns B through E
' based on the value found in B
Dim colNum As Integer
Dim numRows As Integer
Dim i, j As Integer
Dim lastCell As Range
' find the last cell in column B:
Set lastCell = Cells(1, 2).End(xlDown)
numRows = lastCell.Row
For i = 2 To numRows
For j = numRows To i Step -1
If Cells(j, 2) < Cells(j - 1, 2) Then
' swap around each of the cells in this row with the one above
For colNum = 2 To 5
temp = Cells(j - 1, colNum).Value
Cells(j - 1, colNum).Value = Cells(j, colNum).Value
Cells(j, colNum).Value = temp
Next colNum
End If
Next j
Next i
End Sub
I ran this code on the following dummy spreadsheet:
And it resulted in the following output:
As you can see, column A was untouched, and each row in columns B through E is sorted according to the key in column B. You know of course that there is a built in sort function in Excel, but I assume you had reasons for not wanting to use it...
I hope this is what you needed! If it isn't, then please update your question with and example of "I want THIS to turn into THAT".
EDIT 3
Your latest update to the question plus the comment to my solution finally makes it clear what you intend to do. Since we can't really know we have reached the last block until we "fall off the edge", I have modified the code so it has an infinite loop with an error trap (that is generated when you try to go beyond the bottom of the spreadsheet). I tested this with blank row all the way (including blank in column A - note the code no longer uses column A at all):
Sub keepSorting()
Dim colNum As Integer
Dim firstRow, lastRow As Integer
Dim i, j As Integer
' loop around the algorithm we had earlier, but only for the 'non-empty blocks of rows'
firstRow = 1
lastRow = [B1].End(xlDown).Row
On Error GoTo allDone
While True ' break out of the loop when we throw error
' sort from firstRow to lastRow:
For i = firstRow + 1 To lastRow
For j = lastRow To i Step -1
If Cells(j, 2) > Cells(j - 1, 2) Then
' swap around each of the cells in this row with the one above
For colNum = 1 To 5
temp = Cells(j - 1, colNum).Value
Cells(j - 1, colNum).Value = Cells(j, colNum).Value
Cells(j, colNum).Value = temp
Next colNum
End If
Next j
Next i
firstRow = Cells(lastRow + 1, 2).End(xlDown).Row
lastRow = Cells(firstRow, 2).End(xlDown).Row
Wend
allDone:
On Error GoTo 0
End Sub
It turns THIS:
into THIS:
Note - the On Error Resume Next is there because finding the lastRow when firstRow is at the bottom of the sheet generates an error; but since we're done by that time, we just need to exit the while loop...
There are a lot of ways to do this, but if you want to keep your nested For approach the first thing you need to do is find out how many rows there are before you hit a blank.
Dim lngTotalRows As Long
lngTotalRows = 0
While Cells(lngTotalRows + 1, 1) <> ""
lngTotalRows = lngTotalRows + 1
Wend
Now that you have that, you can just basically use your existing code replacing your 15 with lngTotalRows. You do have a couple small problems with your loops though...
Your outer loop should be:
For j = 1 to lngTotalRows - 1
Your inner loop should be:
For i = j + 1 to lngTotalRows
If you look at a couple specific example you will probably see why. You are comparing your outer loop cell to each cell after it, so the first time through the loop our first cell will have j = 1 (so the cell in Row 1) and we are comparing it to every row after that, so we start at j + 1 (which is Row 2), then we look at row 3, row 4 and so on. When the outer loop is looking at Row 10 the inner loop will just look at the values between Row 11 and the end of the sort range.
The outer loop ends at lngTotalRows - 1 because the inner loop will be looking at the cell after that one which will be the last cell in the range.
See if you can implement that in your existing code. If things aren't behaving as you expect use breakpoints and inspect the values while you step through the code. It can be very enlightening. Also you can use Debug.Print statements in your code to output values to the immediate window to help track down problems.
I need an excel formula for this to produce the values on the right column. simple theory. to show when right values has jump by a certain value.
10 0
10 1
11 0
11 1
12 0
12 0
12 0
12 1
13 0
13 0
If I understand correctly, you want 1 when the next value is different, and zero otherwise?
If so, assuming your values are in column A, starting with A1, try the following formula in B1: =IF(A1=A2;0;1) then copy B1 and paste in the whole column B.
Make that =IF(ISBLANK(A2);0;IF(A1=A2;0;1)) to also return 0 if the next cell is blank.
I have been trying to write a macro to re-arrange the Cells in the rows and columns of Stock tables for the output I desire. Luckily the Stock Tables are generally the same each and every time (Different names and values), and the desired outcome is the same format..
Here is some example Data.
A
1 Name
2 description
3 description
4 description
5 description
6 ID#: 56284
7 Quantity in stock: 34
8 Zoom In and Configure
B
1 Name
2 description
3 description
4 description
5 description
6 ID#: 56284
7 Quantity in stock: 50
8 Zoom In and Configure
And I would like the Output to go into something like this(If possible to sheet2 starting on Cell B2):
B C E
B Being Row 1
C being Row 2 3 4 and 5 Combined
E being JUST Row 7 Stock Value I.E 50
On a single spreadsheet there would be 4 columns, and 8 rows I would have to re-arrange.. Making 32 total.
It would be great to automated this, so any help would be greatly appreciated.
Let me clarify my understanding. For each column you want the following data format:
A A
1 Name 1 Name
2 Desc1 2 Desc1; Desc2; Desc3; Desc4
3 Desc2 On sheet 2 3 50
4 Desc3 --------------->
5 Desc4
6 Id#: 56284
7 Quantity in Stock: 50
8 Zoom in and configure
If this is the case you can use the following code. It assumes your data is in A1 to D8 in Sheet 1.
Sub FormatData()
Dim col As Integer
For col = 1 To 4
With Worksheets(2)
.Cells(1, col) = Cells(1, col) //Get name
.Cells(2, col) = Cells(2, col) & "; " & Cells(3, col) & "; " & Cells(4, col) & "; " & Cells(5, col) //Concatenate descriptions into single string
.Cells(3, col) = Cells(7, col) //Get quantity in stock
End With
Next col
End Sub