This question already has answers here:
VBA macro to delete rows quickly
(4 answers)
Closed 6 years ago.
I have to delete all rows that have to cells equal in VBA excel. Here is what i wrote:
Dim i As Long, j As Long
j = Rows.Count
For i = 1 To j
If Cells(i, 17).Value = Cells(i, 19).Value Then Rows(i).Delete
Next i
But this code is not deleting every line I am looking for. If there are 2 rows with matches the conditions respectively, Excel jumps to another one and leaves this (which is logical), I do not know how to adapt this loop to coming back and delete every searched line
What I am understanding from your code is , it is not iterating all the lines since one of the conditions are getting fulfilled .
My recommendation is to reverse loop it. Iterate from the last by using "-1"
Instead of:
For i = 1 To j
If Cells(i, 17).Value = Cells(i, 19).Value Then Rows(i).Delete
Next i
Do this:
For i = j to 1 Step - 1
If Cells(i, 17).Value = Cells(i, 19).Value Then Rows(i).Delete
Next i
When you delete a row you have to decrement the value of i and update the value of j.
Because when you delete a row:
the following row is now at the i position
the number of rows (j) is reduced by 1 row
Related
I have tried, and been unable to find any sample VBA code that fits my needs. What I'm trying to do is find duplicate matches between two columns and consolidate them with respect to a third column, then in a fourth column show how many instances of the duplicate existed originally.
The original data:
The ideal output after removing duplicates:
As you can see, in the output I have 1 instance of 1 in Column A, a in Column B, retained the first value the duplicates started at in Column C and express 2 occurences of the duplicates in Column D. Can anyone point me in the right direction? Any help would be greatly appreciated.
the below code will find the number of occurrences in fourth column and remove the duplicates
Sub foo()
row_count = 20
For i = 2 To row_count
Count = 1
For j = 2 To row_count
If i <> j And Cells(i, 1).Value <> "" Then
If Cells(i, 1).Value = Cells(j, 1).Value And Cells(i, 2).Value = Cells(j, 2).Value Then
Rows(j & ":" & j).Delete Shift:=xlUp
Count = Count + 1
j = j - 1
End If
End If
Next j
If Count > 1 Then
Cells(i, 4).Value = Count
End If
Next i
End Sub
I'm writing a code that copies data from one sheet into another and I've got that function working fine. Now, I'm trying to code it to delete any rows that contain duplicate information based off that information's ID number in column F. Part of our process is to manually enter in column E when each row has been worked.
So my end goal is for the code to delete rows where column E is blank and column F is a duplicate. My code runs, but doesn't delete anything. I'm really hoping I'm just missing something ridiculously obvious.
For i = 1 To Range("f" & Rows.Count).End(xlUp).Row
If Cells(i, 5).Value = "" Then 'if column E is blank on row i
x = Cells(i, 6).Value
If Not IsError(Application.Match(x, "F:F", 0)) Then '& if that row is a duplicate
ActiveSheet.Range(x).EntireRow.Delete 'delete new duplicate row
End If
End If
Next i
Try it with,
For i = Range("f" & Rows.Count).End(xlUp).Row to 1 Step -1
If Cells(i, 5).Value = "" Then 'if column E is blank on row i
x = Cells(i, 6).Value
If Application.Countif(Columns(6), x) > 1 Then '& if that row is a duplicate
Rows(i).EntireRow.Delete 'delete new duplicate row
End If
End If
Next i
You were trying to delete the row number x, not i. Additionally, everything was going to be matched once.
So there are a couple of errors that need to be addressed in your code. First, if you are looping over a range and deleting rows, it's best to start from the bottom and work your way up. This prevents issues where your iterator is on a row, that row gets deleted, and the loop essentially skips the next row.
Next, you are looking for a Match in column F of x, which contains a value from Column F. So, it will always return a value (itself, at the very minimum). Maybe try using a COUNTIF and seeing if it's greater than 1 may be a better option?
Next, you populated the variable x with the value in Cells(i, 6), but then you try to use it as a range when deleting. Change your code to the following and see if it works:
For i = Range("f" & Rows.Count).End(xlUp).Row To 1 Step -1
If Cells(i, 5).Value = "" Then 'if column E is blank on row i
x = Cells(i, 6).Value
If Application.Countif(Columns(6), x) > 1 Then '& if that row is a duplicate
ActiveSheet.Rows(i).Delete 'delete new duplicate row
End If
End If
Next i
Why not use the .RemoveDuplicates method? It's faster than looping around. Here's a rough outline on its use:
With Range
.RemoveDuplicates Columns:=Array(6), Header:=xlYes
End With
Here's the msdn doc for the method, and another page with a more detailed implementation. They should clear up any questions you might have.
This question already has answers here:
Inserting rows above a specified rows
(2 answers)
Closed 7 years ago.
I using the below macro and it inserts the row below the cell with "Card Number"
I cannot get it to go above the row no matter what I do. Probably quite basic for some but have recently only found how useful macros are
Sub Insert()
Dim c As Range
For Each c In Range("A1:A5000")
If c.Value Like "*Card Number:*" Then
c.Offset(1, 0).EntireRow.Insert
End If
Next c
End Sub
As you probably tried you cannot just do c.EntireRow.Insert since it will insert a line above and it will keep in the For Each loop infinitely. The solution is to loop through the range in reverse, like done in this answer:
Sub InsertRev()
Dim c As Range
Set rng = ActiveSheet.Range("A1:A5000")
For dblCounter = rng.Cells.Count To 1 Step -1
Set c = rng(dblCounter)
If c.Value Like "*Card Number:*" Then
c.EntireRow.Insert
End If
Next dblCounter
End Sub
Don't use the Offset in that case, the Insert command always insert rows above the selection.
Further more, if you use for each, you don't have control on the direction in which your loop will be, so it is better to use for i = with step -1 to go from bottom to top.
Why? Because if you insert a new row from row i, the row i will become the row i+1 and you will test it on the next loop and keep adding rows!
Sub Insert_Rows()
Dim i As Long
For i = 5000 To 1 Step -1
If Cells(i, "A").Value Like "*Card Number:*" Then
Cells(i, "A").EntireRow.Insert
End If
Next i
End Sub
This is how I would solve this problem but I'm not that advanced in macros and I'm sure there is a better way.
Sub Insert()
For i = 1 To 5000
If Cells(i, "A") Like "*Card Number:*" Then ' loop trough 5000 cells in column A
Rows(i + 1).Insert 'insert bottom row first so it doesn't mess with row numbers
Rows(i - 1).Insert 'then you can insert upper row
i = i + 1 'jump over the next row as it now contains the card number for sure
End If
Next i
End Sub
I was searching for my problem .. but i couldn't find something good.
Im trying to copy some values from sheet 1 to sheet 2..
In sheet 1("xy") there are no hidden rows. In sheet 2("Adress") there are.
I would use a for-loop to do that:
end = cells(rows.count, 1).end(xlUp).row
Row = 1
For i = 11 To end
Sheets("xy").Select
Cells(Row, 19).Copy
Sheets("Adress").Select
Cells(i, 19).PasteSpecial xlPasteValues
Row = Row + 1
Next i
The problem is that the loop is still using the hidden rows in sheet2("Adress") ...
How can I skip them ?
Thanks for your help :)
The simplest way would be to paste it over separately using multiple paste commands as opposed to all at once as you could skip the hidden rows manually. The following code should work for doing it automatically:
end = cells(rows.count, 1).end(xlUp).row
Row = 1
For i = 11 To end
If Not Worksheet("Adress").Cells(i, 19).hidden Then
Worksheet("Adress").Cells(i, 19) = Worksheet("xy").Cells(Row, 19)
Row = Row + 1
End If
Next i
For context, I have a worksheet with job titles in Column A, then in columns B onwards, it has the name of a person who does that job. However, as it is populated from multiple projects, some job titles have duplicates in the row, where the same person does the same job on different projects. What I need to do is delete the duplicates from each row. All solutions I have tried have given me errors.
Can anyone help?
The data gets to its current form using VBA, copying it from another sheet, so if it could be integrated into the copying, it wouldn't be a problem.
update:
So in an earlier part of the macro, I have to do this, but for a single column. This works:
For np = lastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("D1:D" & np), Range("D" & np).Text) > 1 Then
Range("D" & np).ClearContents
End If
Next np
However, when I tried to add another loop outside this one, and change the D1:D to a variable, I fall down.
And what I want it to do is go from the top 4 rows in the picture, to the bottom 4. I have 78 jobs, and some of them have 20 people including the duplicates http://picture.ms/images/2013/09/18/Capture1.png:
if you want to use two loops, how about something like this
Sub RemoveDuplicates()
Dim i As Integer
Dim j As Integer
For i = 1 To Range("A65536").End(xlUp).Row
For j = i + 1 To Range("A65536").End(xlUp).Row
If Cells(i, 1) = Cells(j, 1) Then
If i <> j Then
'just clear the duplicate cell...
Cells(j, 1).ClearContents
'or to delete the entire row if a duplicate is found...
'Cells(j, 1).EntireRow.Delete
End If
End If
Next
Next
End Sub
NB - I've used Range("A65536").End(xlUp).Row to get the last row of data in column A, in Excel2007 and above there more rows on a worksheet, but it sounds like your data is much less than this anyway