I have this VBA code to delete rows in excel
Sub deleterows()
i = 1
Do Until i = 150000
If ActiveCell.Value = False Then
ActiveCell.EntireRow.Delete
End If
ActiveCell.Offset(1, 0).Activate
i = i + 1
Loop
End Sub
However this code is not deleting all the rows that contain the "False" value, I've been trying to change it to activecell.value="" and activecell.value=vbnullstring but still it does not deletes all blank rows
You should move from the last row to the top, if you're deleting rows.
Also, it's best to avoid using ActiveCell.
Sub deleterows2()
i = 1
For i = 150000 To 1 Step -1
If Cells(i, 1).Value = False Or Cells(i, 1).Value = "False" Then
Rows(i).EntireRow.Delete
End If
Next i
End Sub
Tweak as needed. I'm assuming your column A has the cells you're checking for. If it's another column, just use that column's index number in the Cells(i,1). So if you need to check column D, use Cells(i,4)
You can fix it with a small change as follows:
If ActiveCell.Value = False Then
ActiveCell.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Activate
End If
Basically, you should only activate the next sell when the value is != False, otherwise it will skip rows.
Here's a handful of nice things baked in to what it looks like what you want to accomplish.
I'm assuming that 150000 is basically just a big number so that you are confident that all used rows are being considered.
Sub DeleteRows()
i = 0
Do While ActiveCell.Offset(i, 0).Row <= ActiveCell.End(xlDown).Row
'This only considers used rows - much better than considering 15,000 rows even if you're only using 100
If ActiveCell.Offset(i, 0).Value <> 1 Then
'If you directly have a boolean value (i.e. 'True', 'False', or '0','1', you do not need to compare to another value. If your cells contain text, compare with the string in quotes (i.e. ...= "False")
ActiveCell.Offset(i, 0).Delete
Else: i = i + 1
End If
'Don't have to activate the next cell because we're referencing off of a fixed cell
Loop
End Sub
Related
I want to change the cell style based on the row number. I am still new on VBA.
Here is my code:
Sub format()
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To FinalRow
If Rows.Count = 2 * i + 1 Then
Selection.Style = "Good"
ElseIf Rows.Count = 2 * i Then
Selection.Style = "Bad"
End If
ActiveCell.Offset(1, 0).Select
Next i
End Sub
The loop moves to the next cell but does not highlight if a criteria is met. May you please help me.
I suggest the following:
Option Explicit
Public Sub FormatEvenOddRowNumbers()
Dim FinalRow As Long
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
Dim i As Long
For i = 1 To FinalRow
If i Mod 2 = 0 Then 'even row number
Cells(i, 1).Style = "Good"
Else 'odd row number
Cells(i, 1).Style = "Bad"
End If
Next i
End Sub
To test if a row number is "even" you can use If i Mod 2 = 0 Then also you don't need to test for "odd" because if it is not "even" it must be "odd" so you can just use Else without any criteria.
Try to avoid using .Select it makes your code slow. See How to avoid using Select in Excel VBA. Instead access the cells directly like Cells(row, column).
First, I think you missused Rows.Count.
Rows.Count returns the total number of rows of your sheet. So now your criteria is only highlighting the two rows that are in the middle of the sheet.
If I assume correctly that you want to put "Good" the Rows that are even and "bad" the ones that are odds. then you should change your code to something like this:
Sub format()
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To FinalRow
If i/2 = int(i/2) Then
Selection.Style = "Good"
ElseIf (i+1)/2 = int((i+1)/2) Then
Selection.Style = "Bad"
End If
ActiveCell.Offset(1, 0).Select
Next i
End Sub
I would like to copy the contents in A1:AV1 only if B2:BV2 is populated. I want to copy blank without ending up pasting tab or spaces in blank cells. As a step two I need to copy B2:BV2 to row C eliminating any blank cell. Step three I need to take those entries from row C so that only 4 entries populate the following rows D through the end (no more than 10 rows).
I came up with the following with only a partial paste (the best I could do).
Sub Copy()
If IsEmpty(Range("A2").Value) = False Then
ActiveSheet.Range("A1").Copy Range("A3")
End If
If IsEmpty(Range("B2").Value) = False Then
ActiveSheet.Range("B1").Copy Range("B3")
End If
If IsEmpty(Range("C2").Value) = False Then
ActiveSheet.Range("C1").Copy Range("C3")
End If
If IsEmpty(Range("D2").Value) = False Then
ActiveSheet.Range("D1").Copy Range("D3")
End If
If IsEmpty(Range("E2").Value) = False Then
ActiveSheet.Range("E1").Copy Range("E3")
End If
Sheet1.Range("a3:Y3").SpecialCells(xlCellTypeConstants).Copy ActiveSheet.Range("A4")
End Sub
This worked until AO after that it broke down and did not copy the correct cells. I know this should be done is come type of an array, but I couldn't figure out the loop.
First make better a loop for cell check and copy like this that will include all conditions you want:
PS. i mean the logic in the code not just a code i wrote:
For I = 1 To Sheet1.Columns.Count
If Sheet1.Cells(1, I).Value <> "" and not IsNull(Sheet1.Cells(1, I).Value) Then
I2=I2+1
Sheet1.Cells(2, I2).Value=Sheet1.Cells(1, I).Value
End if
If Sheet1.Cells(2, I2).Value <> "" and not IsNull(Sheet1.Cells(2, I2).Value) Then
I3=I3+1
Sheet1.Cells(3, I3).Value=Sheet1.Cells(1, I2-1).Value
End if
after this point i think you can move forward. otherwise write what you face.
If I run the following code
Sub Test_1()
Cells(1, 1).ClearContents
Cells(2, 1).Value = ""
End Sub
When I check Cells(1, 1) and Cells(2, 1) using formula ISBLANK() both results return TRUE. So I'm wondering:
What is the difference between Cells( , ).Value = "" and Cells( , ).ClearContents?
Are they essentially the same?
If I then run the following code to test the time difference between the methods:
Sub Test_2()
Dim i As Long, j As Long
Application.ScreenUpdating = False
For j = 1 To 10
T0 = Timer
Call Number_Generator
For i = 1 To 100000
If Cells(i, 1).Value / 3 = 1 Then
Cells(i, 2).ClearContents
'Cells(i, 2).Value = ""
End If
Next i
Cells(j, 5) = Round(Timer - T0, 2)
Next j
End Sub
Sub Number_Generator()
Dim k As Long
Application.ScreenUpdating = False
For k = 1 To 100000
Cells(k, 2) = WorksheetFunction.RandBetween(10, 15)
Next k
End Sub
I get the following output for runtime on my machine
.ClearContents .Value = ""
4.20 4.44
4.25 3.91
4.18 3.86
4.22 3.88
4.22 3.88
4.23 3.89
4.21 3.88
4.19 3.91
4.21 3.89
4.17 3.89
Based on these results, we see that the method .Value = "" is faster than .ClearContents on average. Is this true in general? Why so?
From what I have found, if your goal is to simple have an empty cell and you do not want to change anything about the formatting, you should use Value = vbNullString as that is the most efficient.
The 'ClearContents' is checking and changing other properties in the cell such as formatting and the formula (which is technically a separate property than Value). When using Value = "" you are only changing one property and so it is faster. Using vbNullString prompts the compiler that you are using an empty string versus the other way with double quotes, it is expecting a general string. Because vbNullString prompts it to expect an empty string, it is able to skip some steps and you get a performance gain.
when apply both in single cell I don't think there is no any sensible deferent but when you apply it in range Range("A1:Z1000").ClearContents is easier and faster than use cell(i,j).value="" in nested loop or one for loop
I did find one difference that might be of note. ClearContents returns a value, which seems to be of type Boolean in my limited testing (docs mention Variant type).
Option Explicit
Public Sub ClearA1()
Dim a As Range
Dim b As Boolean
Set a = Range("A1")
Debug.Print b 'It's False, the default value
b = a.ClearContents
Debug.Print b 'Set to True, as the action was completed
End Sub
I'd guess some of the overhead is from the fact ClearContents does return a value, where you are just setting a value property in the alternate case.
Ultimately, in terms of outcomes of setting the value both methods appear functionally the same.
Using clearcontent has different behavior on cells with formulas.
When you have just one value, the behavior is the same, but differs when you have formulas in it.
You can notice a big difference in Excel spreadsheet.
Assume that B1 is filled by equation returns blank
A1 = 5
B1 = "=if(A1=5,"","x")
In this case, you have to equations that you can write in C1
(1) C1 = <=isblank(B1)>
(2) C1 =
Solution 1 will return false, as the cell is filled with equation
Solution 2 will return True
I came across this topic a little late, but i would like to share what i have noticed with abit of code of mine, i don't think i can fully explain it but ill do my best.
For Each Cell In ws.Range("D12:D161") 'Order feed colom
Select Case Cell.Value
Case 0
Cell.Interior.Color = Cell.Offset(0, -1).Interior.Color
Case 1
Cell.Interior.Color = 10198015
Case 2
Cell.Interior.Color = 11854022
End Select
Cell.value = ""
Next Cell
This is a bit of code that i have used in order to clear some fields and give some color to the range D12:D161. Nothing special here, If the value is 0 then copy your neighbor if 1 then red if 2 then green. And clear the cell afterwards
But in order for this code to run it took roughly 5-6 seconds for me, which i thought was a fair bit for a small piece of code. Plus i used this on a Private Sub Workbook_SheetActivate(ByVal Sh As Object) which made it for the user unpleasant to wait 5-6 seconds for a screen transition. So i put a loop in to check for empty's in a row and then skip out.
It is noteworthy that this is part of a script, and yes i have my screenupdating off, calculations off, events off during this piece of code.
For Each Cell In ws.Range("D12:D161") 'Order feed colom
Select Case Cell.Value
Case 0
Cell.Interior.Color = Cell.Offset(0, -1).Interior.Color
Erow = Erow +1
Case 1
Cell.Interior.Color = 10198015
Erow = 0
Case 2
Cell.Interior.Color = 11854022
Erow = 0
End Select
Cell.value = ""
if Erow = 10 then exit for
Next Cell
Now instead of having to do 149 rows i did roughly 58 rows, depending on my data in the column. But still it it took 3-4 seconds in order to fully run. During Debug mode i noticed no lag at all. If i manually ran the code when already on the sheet, there was 0 delay. Almost instant, after testing abit more but when using a Private Sub Workbook_SheetActivate(ByVal Sh As Object) with this code it still ran 3-4 seconds.
After testing individual rows of code, i came across the .Value = "". Removing this line from the code made it run 0,5 seconds.... So now i knew where my problem was, using multiple ways of emptying my cells. I noticed that .clearcontents was the fastest for me. Apparently if you move from Sheet to sheet EVENTHOUGH ws. has been declared as my active sheet, it just ook alot of time
For Each Cell In ws.Range("D12:D161") 'Order feed colom
Select Case Cell.Value
Case 0
Cell.Interior.Color = Cell.Offset(0, -1).Interior.Color
Erow = Erow +1
Case 1
Cell.Interior.Color = 10198015
Erow = 0
Case 2
Cell.Interior.Color = 11854022
Erow = 0
End Select
Cell.ClearContents 'DONT USE .Value = "", makes the code run slow
if Erow = 10 then exit for
Next Cell
In conclusiong.
Using the above code with
.value = "" took 4-5 seconds
.value = VbNullstring took 3-4 seconds
.ClearContents took only 0,5 seconds. But only during a worksheet transition
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If anybody is able to explain why this is or what exactly is going on, i would appreciate it.
I have a huge datasheet in excel, which i need sorted.
I need two columns to match based on a Dummy.
The dummy is either 'C'(call) or 'P'(put). The two other columns are 'expiration date' and 'strike price'.
I need to sort the datasheet so it is only containing C and P that have the same expiration date and strike price.
I've been trying go search the internet without any help. I can't really figure out how to program it in VBA.
Any help is really appreciated.
Thanks.
The solution I think: (I am addin a new column -column W- which is empty- to mark the row as "Matched" which is to be deleted after operation.)
First sub to mark the doublets (Matched Rows):
Private Sub FindDoublets()
Dim intRowC As Long
Dim intRowP As Long
Application.ScreenUpdating = False
Range("W1").EntireColumn.Insert
For intRowC = 2 To ActiveSheet.UsedRange.Rows.Count
If Cells(intRowC, 6).Value = "C" Then
For intRowP = 2 To ActiveSheet.UsedRange.Rows.Count
If Cells(intRowP, 6).Value = "P" Then
If Cells(intRowC, 4).Value = Cells(intRowP, 4).Value And Cells(intRowC, 7).Value = Cells(intRowP, 7).Value Then
Cells(intRowC, 23).Value = "Matched"
Cells(intRowP, 23).Value = "Matched"
End If
End If
Next
End If
Next
Application.ScreenUpdating = True
End Sub
Second sub to delete not matched so not marked rows:
Private Sub DeleteNotMatchedRows()
Dim intRow As Long
Application.ScreenUpdating = False
For intRow = ActiveSheet.UsedRange.Rows.Count To 2 Step -1
If Cells(intRow, 23).Value <> "Matched" Then
Rows(intRow).Delete shift:=xlShiftUp
End If
Next
Range("W1").EntireColumn.Delete
Application.ScreenUpdating = True
End Sub
In your example sheet enter this formula in column W: =IF(F2="C",TRUE,FALSE) and this one into column X: =COUNTIFS(D:D,D2,G:G,G2,W:W,NOT(W2))
Now you will have "1" in column X when actual row has a corresponding C / P row and "0" otherwise. Just need to filter for 0-s and delete the rows.
You can do the same with macro too but it's more complicated.
I am new to vba and have only been using it for a couple of months. I've basically been learning as I go. Despite that, I'm trying to write some code to care for a variety of functions. I have written the code below that is launched from a command button on a userform. The code basically is supposed to search a row in an Excel worksheet and verify a couple of pieces of information and then take action. If the code cannot verify a match between entries on the row and entries in the userform, it stops and displays an error message. If it can verify the information match, it is supposed to proceed with populating some information on that row. I realize that this code I've written is probably completely hamfisted and decidedly un-elegant, however it was working until I added the validation for the product code. Please, can someone help? I've looked and looked and cannot find a solution.
Here is the code:
Private Sub AddDelivButton_Click()
Sheets("Deliveries").Activate
Dim number As Integer, rownumber As Integer, result As Long, i As Integer
number = POTextBox.Value
rownumber = 0
result = 1000000
For i = 1 To 25000
If Cells(i, 1).Value = number Then
result = Cells(i, 1).Value
rownumber = i
End If
Next i
If result = 1000000 Then
MsgBox "PO Number Not Found"
Sheets("Dashboard").Activate
Exit Sub
Else
Cells(rownumber, 1).Select
ActiveCell.EntireRow.Cells(3).Select
If ActiveCell.Value <> ProdCodeListBox1.Value Then
ActiveCell.EntireRow.Cells(5).Select
If ActiveCell.Value <> ProdCodeListBox1.Value Then
ActiveCell.EntireRow.Cells(7).Select
If ActiveCell.Value <> ProdCodeListBox1.Value Then
MsgBox "Product Code Not Found"
Sheets("Dashboard").Activate
Exit Sub
Else
ActiveCell.EntireRow.Cells(10).Select
If ActiveCell.Value = "" Then
ActiveCell.Value = ProdCodeListBox1.Value
ActiveCell.EntireRow.Cells(11).Value = WeightTextBox1.Value
ActiveCell.EntireRow.Cells(12).Value = DateTextBox1.Value
Else
ActiveCell.EntireRow.Cells(13).Select
If ActiveCell.Value = "" Then
ActiveCell.Value = ProdCodeListBox1.Value
ActiveCell.EntireRow.Cells(14).Value = WeightTextBox1.Value
ActiveCell.EntireRow.Cells(15).Value = DateTextBox1.Value
Else
This goes on for several iterations and to save space I have not included all of them here. Suffice it to say that the last two if statements were working until I added the validation for the ProdCodeListBox1.
Any help would be very much appreciated! Even if it is something simple I am overlooking.
Thanks!
In your current code you check cells 3, 5 and 7 for a matching value and display an error if none of them match then exit the Sub altogether. You only go on to check cell 10 if cell 7 has a match. If cells 3 or 5 match you never get to the check on cell 10
Try this instead:
ActiveCell.EntireRow.Cells(3).Select
If ActiveCell.Value <> ProdCodeListBox1.Value Then
ActiveCell.EntireRow.Cells(5).Select
If ActiveCell.Value <> ProdCodeListBox1.Value Then
ActiveCell.EntireRow.Cells(7).Select
If ActiveCell.Value <> ProdCodeListBox1.Value Then
MsgBox "Product Code Not Found"
Sheets("Dashboard").Activate
Exit Sub
End If
End If
End If
ActiveCell.EntireRow.Cells(10).Select
If ActiveCell.Value = "" Then
All of the ActiveCell and Select business isn't the best way to get the values from specific cells but that's a different question