I am writing a script in VBA that would remove duplicate rows in an Excel spreadsheet. However, I want it to delete duplicate rows considering only information in two columns.
In other words, I have a table with the range B:F. I want the script to remove duplicate rows considering, for each row, only the values on columns D and E. In the end, only rows which simultaneously have the exact same values on columns D and E - regardless of other columns - will be removed. How could I go about doing this? Thank you
Here is an example that does this.
Make sure you run it with the sheet you want to use up:
Sub DeleteDupes()
Dim x
For x = Cells(Rows.CountLarge, "D").End(xlUp).Row To 1 Step -1
If Cells(x, "D") = Cells(x, "E") Then
'This line deletes the row:
Cells(x, "D").EntireRow.Delete xlShiftUp
'This line highlights the row to show what would be deleted;
'Cells(x, "D").EntireRow.Interior.Color = RGB(230, 180, 180)
End If
Next x
End Sub
Results of highlighting:
Results of Delete:
Related
Can't find the correct syntax for the dynamic range, please help.
On 'Sheet1' I have a source table range "B2:F50"
For each row in that table need to test certain condition
If condition is met THEN copy that table line to a new position,
on 'Sheet1' Example:
FOR I = 1 TO 50 ' I for each Row)
IF certain cell = x THEN
'copy that table line entries (not entire row) to a new position
Range(source I, source-Col).Copy (target I, target-Col)
END IF
NEXT I
Basically creating a new table (On same rows, shifted columns) but with only entries
that meet the condition. Don't want to copy entire rows.
Many thanks
Sam
I believe something along these lines should sort out your problem:
Set dataWS = ThisWorkbook.Sheets("Sheet1")
For i = 2 to 50
If dataWS.Cells(i,1).value = x Then
dataWS.Range(dataWS.Cells(i, 2), dataWS.Cells(i, 5)).Copy Destination:=dataWS.Range(dataWS.Cells(i, 12), dataWS.Cells(i, 15))
End If
Next i
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.
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
How can I delete the whole row of an Excel sheet, if in the column G has a number that starts with 210.
I don't want to delete the row if the cell has 210 somewhere inside, but only when start with it.
Use this code:
Sub RemoveRows()
Dim i As Long
i = 1
Do While i <= ThisWorkbook.ActiveSheet.Range("G1").CurrentRegion.Rows.Count
If Left(ThisWorkbook.ActiveSheet.Range("G" & i).Formula, 3) = "210" Then
ThisWorkbook.ActiveSheet.Cells(i, 1).EntireRow.Delete
Else
i = i + 1
End If
Loop
End Sub
Sample file: https://www.dropbox.com/s/yp2cwphhhdn3l98/RemoweRows210.xlsm
To see it and run, press ALT-F11, open Module1 and press F5. Good luck!
In case you want to do it without code but purely in the UI, this is how you could do this pretty efficiently:
Insert a temporary column (e.g. right of column G) (Ctrl-Space in any cell in column H, Ctrl-+)
Fill the column with the formula =LEFT(TEXT(G1),3)="210" - this will return TRUE for all rows you look for
Apply an AutoFilter to either that new column or the full range (Ctrl-Shift-L)
Filter that column for TRUE - this way, only the rows you wish to delete remain
Select all rows and delete (Ctrl-A in any cell in the table, Shift-Space, Ctrl--)
Delete the temporary column (Ctrl-Space in any cell in column H, Ctrl--)
Done!
Thank you for the comments so far, it has helped me formulate my question better/differently.
I have two sheets, Sheet1 and Sheet2.
Sheet1 contains ~100,000 rows with 5 columns and Sheet2 should contain a subgroup of Sheet1, depending if the rows in Sheet1 contain certain values in certain columns.
This is the code I have so far. Somehow the VBA doesn't give me any error, but the code also doesn't run, which makes it difficult to find a possible solution. Anyone any ideas?
Sub CopyRows()
Dim r As Integer
Dim cell As Range
r = 2
For Each cell In Selection
If Application.WorksheetFunction.IsNA(Sheets("Sheet1").Cells(r, 1)) = False Then
If Sheets("Sheet1").Cells(r, 3) = "Product1" or "Product2" Then
If Sheets("Sheet1").Cells(r, 5) = "2011" or "2012" Then
If Sheets("Sheet1").Cells(r, 4) > 0 Then
cell.EntireRow.Copy Destination:=activesheet.Rows(r)
r = r + 1
End If
End If
End If
End If
Next cell
End Sub
For such consolidations my first bet would be a Pivot table; in your case
Company & City at the vertical
product at the horizontal (if not too many)
count or sum of value inside
plus eventually a filter to exclude empty key fields.
If you arrange your sheet1 so that there is only one header line in row 1, you can select entire columns (say $A:$D) as pivot table input range, and any additional rows will be included in the Pivot upon refresh.
Of course, the Pivot table can be sorted, filtered, subtotaled etc. etc.