...because the row is only evaluated once and the next row is called for evaluation. But the next row is now the previous row. How do I account for this?
For i = 5 To Range("A" & "65536").End(xlUp).Row Step 1
If Application.WorksheetFunction.CountIf(Range("A" & i), "#N/A") = 1 Then
Range("A" & i).EntireRow.Delete
End If
Next i
You can delete your rows all at once, using Union. Like this:
Sub test()
Dim i As Long
Dim deleteRange As Range
For i = 5 To Range("A" & "65536").End(xlUp).Row Step 1
If Application.WorksheetFunction.CountIf(Range("A" & i), "#N/A") = 1 Then
If deleteRange Is Nothing Then
Set deleteRange = Range("A" & i).EntireRow
Else: Set deleteRange = Union(deleteRange, Range("A" & i).EntireRow)
End If
End If
Next i
deleteRange.Delete
End Sub
Loop backwards (and use Rows.Count rather than hard-coding 65536) as new versions of Excel have a capacity of more than a million rows.
For i = Range("A" & Rows.Count).End(xlUp).Row To 5 Step -1
If Application.WorksheetFunction.CountIf(Range("A" & i), "#N/A") = 1 Then
Range("A" & i).EntireRow.Delete
End If
Next i
Related
I want to select whole rows of a range (C14:M34) if value = 1 in a column(F14:F34). Otherwise I want to select the same rows except a specific column(G).
I can do this if I have only a single row but how can I apply this for a range (multiple rows)?
Hereby my code (which is not working):
ActiveSheet.Range("$C$13:$M$34").AutoFilter Field:=6, Criteria1:="<>"
Dim d As Range
For Each d In Range("F14:F34")
If d.Value = 1 Then
ActiveSheet.Range("C14:M34").Select
Else
Application.Union(Range("C14:F34"), Range("H14:M34")).Select
End If
Selection.Copy
Next d
Try this code, please:
Sub testSelecting()
Dim sh As Worksheet, rngSel As Range, i As Long
Set sh = ActiveSheet
For i = 14 To 34
If sh.Range("F" & i).Value = 1 Then
If rngSel Is Nothing Then
Set rngSel = sh.Range("C" & i & ":M" & i)
Else
Set rngSel = Union(rngSel, sh.Range("C" & i & ":M" & i))
End If
Else
If rngSel Is Nothing Then
Set rngSel = Union(sh.Range("C" & i & ":F" & i), sh.Range("H" & i & ":M" & i))
Else
Set rngSel = Union(rngSel, sh.Range("C" & i & ":F" & i), sh.Range("H" & i & ":M" & i))
End If
End If
Next i
If rngSel.Cells.count > 1 Then rngSel.Select: Stop
rngSel.Copy
End Sub
The code is not tested, because I do not have your file to do that. It is based only on logic. It stops after selection, in order to let you appreciate that the selected range is the one you need.
Please confirm that it works as you need, or what problem does it create, if any...
I got multiple if statements, they check the cells column by column if there is a value "Yes" or "Mediocre". When "Yes" add +1 to the outcome if "Mediocre" add +0.5.
So my problem is as follows: When my code needs to check the next column it needs to do the same but then add +1 or +0.5 to the previous outcome on the same line in the same cell.
This needs to happen on every line.
Eventually when it checked the whole line, the outcome needs to be a percentage: count yes and mediocre then devide by 9 and multiple by 100.
I got an image how it should be below:
Example how it should be
I got the code below:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range("D2:L4"), Range(Target.Address)) Is Nothing Then
'If you add (an)other row(s) edit this code above
Call DeleteP2P4
'If you add (an)other row(s) edit this code above
Call SampleMacro
End If
End Sub
Sub DeleteP2P4()
Range("P2:P4").Select
'If you add (an)other row(s) edit this code above
Selection.ClearContents
End Sub
Sub SampleMacro()
' Get the last row
Dim startRow As Long, lastRow As Long
startRow = 2
lastRow = Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp).Row
For i = startRow To lastRow
' If there's Yes/Mediocre in D column, then append next number
If Sheet1.Range("D" & i).Value = "Yes" Then
Sheet1.Range("P" & i).Value = "+1"
ElseIf Sheet1.Range("D" & i).Value = "Mediocre" Then
Sheet1.Range("P" & i).Value = "+0.5"
End If
' If there's Yes/Mediocre in E column, then append next number
If Sheet1.Range("E" & i).Value = "Yes" Then
Sheet1.Range("P" & i).Value = "+1"
ElseIf Sheet1.Range("E" & i).Value = "Mediocre" Then
Sheet1.Range("P" & i).Value = "+0.5"
End If
'It continious here with the rest of the If statements
Next
End Sub
As pointed out by Brownish Monster, Change your
Sheet1.Range("P" & i).Value = "+1"
to
Sheet1.Range("P" & i).Value = val(Sheet1.Range("P" & i).Value) + 1
and similarly for Mediocre
Sheet1.Range("P" & i).Value = val(Sheet1.Range("P" & i).Value) + 0.5
I am writing a code that put an X in a cell depending on a offset cell value, for exemple if the offset cell has a value of 3, it will put an X in the cell and decrement the offset cell value, i want to save the location of that cell and start the next for each with it.
For Each Cell In plage
If (Cell.Offset(0, 1).Value <> 0) Then
If (Cell.Value <> "X") Then
Cell.Offset(0, 1).Value = Cell.Offset(0, 1).Value - 1
Cell.Value = "X"
Checkpoint = Cell.Address
Exit For
Else
Cell.Value = ""
GoTo NextStep
End If
Exit For
Else
Cell.Value = ""
End If
NextStep:
Next Cell
The problem i am having with the current code is it start the loop all over again while i want it to keep till the end of the lines, until all offset value are equal to 0.
Try the below (there are notes on the code). If you face difficulties let me know.
Option Explicit
Sub test()
'In this example we assume that the data you want to loop appear in Column A
Dim i As Long, Lastrow As Long
Dim Checkpoint As Variant
With ThisWorkbook.Worksheets("Sheet1") '<- Change sheet name if needed
Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row '< -Fins the lastrow of the column you want to loop
For i = 2 To Lastrow ' < -Start looping from row 2 to Lastrow fo the column
If .Range("A" & i).Offset(0, 1).Value <> 0 Then '<- You are looping
If .Range("A" & i).Value <> "X" Then
.Range("A" & i).Offset(0, 1).Value = .Range("A" & i).Offset(0, 1).Value - 1
.Range("A" & i).Value = .Range("A" & i).Value & "X"
Checkpoint = .Range("A" & i).Address
Else
.Range("A" & i).Value = ""
End If
Else
.Range("A" & i).Value = ""
End If
Next i
End With
End Sub
Is plage a range?
If so, you could update it to start from the checkpoint and include all cells up to some lastCell for example.
Something like:
set plage=thisWorkbook.Worksheets("Your Worksheet").Range(checkpoint,lastCell)
That way the next For-Each should start from your checkpoint.
BTW if I understand correctly what you'e trying to do, I would suggest you replace cell.value="" with cell.clearContents
I have been able to find code that will merge rows and delete the duplicate rows that are not needed any more and sum one of the columns. However, those codes are based on ActiveCells, which will not work for me. I need this to work on a large range of data. As in the example below, there will be rows of 2, 3, or more rows that need to be merged. But I also have an additional requirement that I just cannot find a solution for. Below is a small set of data that we can use as an example. There are 4 columns here (there are 5 more columns in the actual data set, but they are all duplicate data and not needed for this example) that represents the challenge. I would need to merge these three rows into one, add the values in column B (continued below)
The final result would be this where the earliest Start date & time is kept and the latest start date & time are also kept:
The data will be in columns A through Z (row 1 is a header column), and data is added hourly. For all my other code, I typically limit the number of rows to 2000. We have not exceeded that yet. I have a custom menu that I will use to trigger the code as the purpose is to have as little user input as possible (automation is key). Is there a way to do this with VBA?
If column A is sorted then try this code:
Sub Test()
Dim Rng As Range, dRng As Range
Dim i As Long, LR As Long 'lastrow
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
LR = Range("A" & Rows.Count).End(xlUp).Row
Set Rng = Range("A2:D2")
For i = 3 To LR
If Rng(1) = Cells(i, 1) Then
Set Rng = Range(Rng(1), Cells(i, 4))
Else
If Rng.Rows.Count > 1 Then GoSub mSub
Set Rng = Range(Cells(i, 1), Cells(i, 4))
End If
Next
If Rng.Rows.Count > 1 Then GoSub mSub
If Not dRng Is Nothing Then dRng.EntireRow.Delete
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
Exit Sub
mSub:
With WorksheetFunction
Rng(2) = .Sum(Rng.Columns(2))
Rng(3) = .Min(Rng.Columns(3))
Rng(4) = .Max(Rng.Columns(4))
End With
If dRng Is Nothing Then
Set dRng = Range(Rng(2, 1), Rng(Rng.Count))
Else
Set dRng = Union(dRng, Range(Rng(2, 1), Rng(Rng.Count)))
End If
Return
End Sub
Here is a quick bit of code I put together for you. It will do what you are asking for, but I believe there are better ways of doing it with more information on what you are looking for.
Sub combineLikes()
endRng = Range("D92000").End(xlUp).Row
i = 2
Do Until i > endRng
If Range("A" & i).Value = Range("A" & i).Offset(1, 0).Value Then
Range("B" & i).Value = Range("B" & i).Value + Range("B" & i).Offset(1, 0).Value
If Range("C" & i).Value > Range("C" & i).Offset(1, 0).Value Then Range("C" & i).Value = Range("C" & i).Offset(1, 0).Value
If Range("D" & i).Value < Range("D" & i).Offset(1, 0).Value Then Range("D" & i).Value = Range("D" & i).Offset(1, 0).Value
Rows(i + 1).EntireRow.Delete
endRng = endRng - 1
Else
i = i + 1
End If
Loop
End Sub
I have written a macro to delete the row if it is a blank row or if in column B the cell contains the string XYZ. However, this macro can take a couple minutes to run if there is 200+ rows of data. Can anyone provide anything more efficient in VBA format?
Sub DeleteBlanks()
Dim lr As Long, r As Long
For r = Cells(Rows.Count, "B").End(xlUp).Row To 1 Step -1
Range("B" & r).Replace "*XYZ*", "", xlWhole
If Range("B" & r).Value = "" Then
Range("B" & r & ":Q" & r).Delete (xlShiftUp)
End If
Next r
Application.ScreenUpdating = False
End Sub
I would add the ScreenUpdating line to the top, and also turn calculation to manual:
Sub DeleteBlanks()
Dim lr As Long, r As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For r = Cells(Rows.Count, "B").End(xlUp).Row To 1 Step -1
Range("B" & r).Replace "*XYZ*", "", xlWhole
If Range("B" & r).Value = "" Then
Range("B" & r & ":Q" & r).Delete (xlShiftUp)
End If
Next r
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
As you have it, the entire macro runs, then the screenUpdating is turned off. You can speed it up by putting that up front, then turning it back on when the macro is finished.
In addition to what #BruceWayne said, I will shorten the code
Range("B" & r).Replace "*XYZ*", "", xlWhole
If Range("B" & r).Value = "" Then
With
If Range("B" & r).Value = "" Or InStr(1, Range("B" & r).Value, "XYZ") > 0 then
That will lower the actions that the code needs to make.
First of all, the screen updating should be disabled before the proccess, and re-enabled after that, so the screen will not flash, and load of resources will not be high.
Other than that, text replacement is completely unneeded in your case.
By reading your current code, I assume you consider a blank row if it's empty on column B.
Try this:
Sub DeleteBlanks()
Application.ScreenUpdating = False
Dim lr As Long, r As Long
For r = Cells(Rows.Count, "B").End(xlUp).Row To 1 Step -1
If Range("B" & r).Value = "" Or Range("B" & r).Value Like "*XYZ*" Then
Range("B" & r & ":Q" & r).Delete (xlShiftUp)
End If
Next r
Application.ScreenUpdating = True
End Sub
This solution should be virtually instantaneous:
Public Sub Colin_H()
Dim v, rCrit As Range, rData As Range
With [a1]
Set rData = .Resize(.Item(.Parent.Rows.Count).End(xlUp).Row, .Item(, .Parent.Columns.Count).End(xlToLeft).Column)
End With
Set rCrit = rData.Resize(2, 2).Offset(, rData.Columns.Count + 1)
rCrit.Resize(1) = rData(1, 2): rCrit(2, 1) = "*": rCrit(2, 2) = "<>*xyz*"
rData.AdvancedFilter xlFilterCopy, rCrit, rCrit.Resize(1, 1).Offset(, 2)
With rCrit.Resize(1, 1).Offset(, 2).Resize(rData.Rows.Count, rData.Columns.Count)
v = .Value2
rData = v
.ClearContents
rCrit.ClearContents
End With
End Sub
Notice that there is no looping, no row shifting, and no iterated range construction.
This uses the advanced filter of the range object to filter your records in one quick blast to a range adjacent to your source data. The result is then copied over the source without using the clipboard. There is no quicker or more efficient way to achieve your objective.