I am currently trying to create a program that will Search through an excel file and delete duplicate entries.
I have made this code that does this. However, I also need it to delete the entry before the duplicate and after the duplicate. I've looked everywhere and can not find any examples, please help!
These are my example entries
The1
Car
Car
The2
I'd need it to delete The1 and both Car entries leaving the The2.
Here is my code so far
Sub rar()
Dim i As Long
With Worksheets("Sheet1") 'DEFINES WHICH SHEET TO USE'
For i = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
If Cells(i, 1).Value = Cells(i - 1, 1).Value Then
Rows(i+1).Delete
Rows(i).Delete
Rows(i-1).delete
End If
Next i
End With
End Sub
As Chris Neilsen pointed out below - using With was a great idea, but you need to put a . before your cell and range references to ensure they refer to the worksheet you specified in your With token
Try this:
Sub rar()
Dim i As Long, rng As Range
With Worksheets("Sheet1") 'DEFINES WHICH SHEET TO USE'
For i = 3 to .Cells(.Rows.Count, "A").End(xlUp).Row
If .Cells(i, 1).Value = .Cells(i - 1, 1).Value Then
If rng Is Nothing Then
Set rng = .Rows(i - 2 & ":" & i)
Else
Set rng = Union(rng, .Rows(i - 2 & ":" & i))
End If
End If
Next i
End With
rng.Delete
End Sub
Note: untested - but the idea is to create build up your range as you loop through and then delete at the end. This way you don't have to worry about looping backwards.
Related
I'm brand new to VBA for excel (like a few hours ago new) and not really a programmer, so bear with me.
I have an excel data set, all in one column (column A) that is structured like this:
Data
Data
Data
Data
Data
Data
Data
Data
Data
Data
Data
Data
Data
That is, the data blocks are separated by blank rows, but not at regular intervals. I'm trying to write a macro that will go through the file and Group (the specific excel command) these blocks of data together. So far I have this:
Set firstCell = Worksheets("627").Range("A1")
Set currentCell = Worksheets("627").Range("A1")
Do While Not IsEmpty(firstCell)
Set firstCell = currentCell
Do While Not IsEmpty(currentCell)
Set nextCell = currentCell.Offset(1, 0)
If IsEmpty(nextCell) Then
Range("firstCell:currentCell").Select
Selection.Rows.Group
Set firstCell = nextCell.Offset(1, 0)
Else
Set currentCell = nextCell
End If
Loop
Loop
I'm sort of stuck, having particular trouble with the logic of moving to the next block of data and initiating.
Any help would be appreciated!
How about something like this:
Option Explicit
Public Sub tmpTest()
Dim i As Long
Dim lngLastRow As Long
With ThisWorkbook.Worksheets(1)
lngLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = lngLastRow To 1 Step -1
If .Cells(i, 1).Value2 = vbNullString Then
.Range(.Cells(i + 1, 1), .Cells(lngLastRow, 1)).EntireRow.Group
lngLastRow = i - 1
End If
Next i
.Range(.Cells(1, 1), .Cells(lngLastRow, 1)).EntireRow.Group
End With
End Sub
Here ya are. You just need to pull addresses in your range instead of trying to refer to the object. You also need to reset both current and first cell in your if statement.
Sub test()
Set firstCell = Worksheets("test2").Range("A1")
Set currentcell = Worksheets("test2").Range("A1")
Do While Not IsEmpty(firstCell)
Set firstCell = currentcell
Do While Not IsEmpty(currentcell)
Set nextcell = currentcell.Offset(1, 0)
If IsEmpty(nextcell) Then
Range(firstCell.Address, currentcell.Address).Select
Selection.Rows.group
Set currentcell = nextcell.Offset(1, 0)
Set firstCell = nextcell.Offset(1, 0)
Else
Set currentcell = nextcell
End If
Loop
Loop
End Sub
First of all, your code goes wrong when it says
Range("firstCell:currentCell").Select
You are trying to select the range named "firstCell:currentCell" instead of
selecting range from first Cell to currentCell
You should change it to
.Range(firstCell,currentCell).select
Try using below code and see if it does what you want it to do
Dim GROUP_LAST_CELL As Range
With Worksheets("627")
LAST_ROW = .Range("A" & Rows.Count).End(xlUp).Row
I = 1
While I <= LAST_ROW
Set GROUP_LAST_CELL = .Cells(I, 1).End(xlDown)
.Range(.Cells(I, 1), GROUP_LAST_CELL).Rows.Group
I = GROUP_LAST_CELL.Row + 2
Wend
End With
According to what i understood from the question, i think what you want to do is to loop across all the elements in a particular column, skipping all the blanks.
You can do so by
Calculating the lastrow of the column
Looping across from the first row count to the calculated lastRow count
Applying a condition within the loop to only print the non-empty cells
Code Block
Sub test()
Dim j As Long, lastRow As Long
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
For j = 1 To lastRow
If Cells(j, "A").Value <> "" Then
MsgBox (Cells(j, "A").Value)
End If
Next j
End Sub
I Hope this helped!
I'm looking to create a macro that deletes all rows that don't contain any data in Column B. Any help would be appreciated. This is all I got for now.
Sub DeleteAllEmptyBRows()
Dim lr As Long
lr = Cells(Rows.Count, "B").End(xlUp).Row
For Each cell In Range("B1:B" & lr)
If cell.Value = "" Then
cell.Row.Delete
Exit Sub
End If
Next cell
End Sub
You can use SpecialCells to do this in one quick line:
Range("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
I'd use the above, but also for your own knowledge, here's how you could do it following your code:
Sub DeleteAllEmptyBRows()
Dim lr As Long, i&
lr = Cells(Rows.Count, "B").End(xlUp).Row
For i = lr To 1 Step -1 'Since you're deleting rows, start at the end, and work upwards
If Cells(i, 2).Value = "" Then
Cells(i, 2).EntireRow.Delete
End If
Next i
End Sub
Note that you have an Exit Sub in yours, after the first time a row is deleted. I removed that, since you want to loop through all cells in the range. Again, this is a loop so will take longer, and has more room for errors, than the simple one liner above.
You are missing some parameters:
Cells(cell.Row, 2).Delete Shift:=xlUp
If you need the entire row, just change to:
cell.Row.EntireRow.Delete
I need some help with this macro. I have a workbook that is formatted pretty poorly, but consistently every time I open it. Among other things, the goal is to find the non-blank cells in column B and delete the entire 2 rows below and the 1st row above each of those populated B cells.
The first loop I have in the code works just the way I want it to, but the second loop seems to only work on the 1st instance of a populated B cell, but then it deletes everything else above it, like 500 cells worth of data.
Can someone explain to me why this is happening, and if you could find a way to combine both of those for loops into 1, that would be nice too.
Sub test()
Dim currentSht As Worksheet
Dim startCell As Range
Dim lastRow As Long, lastCol As Long
Dim colNames As Variant
Dim i As Integer, j As Integer
Set currentSht = ActiveWorkbook.Sheets(1)
Set startCell = currentSht.Range("A1")
lastRow = startCell.SpecialCells(xlCellTypeLastCell).Row
lastCol = startCell.SpecialCells(xlCellTypeLastCell).Column
For i = lastRow To 1 Step -1
If currentSht.Cells(i, "B").Value <> "" Then
currentSht.Cells(i, "B").Offset(1).EntireRow.Delete
End If
Next i
Range("D3").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Delete Shift:=xlUp
currentSht.Rows("1:1").EntireRow.Delete
currentSht.Range("c:d, f:g, i:k").EntireColumn.Delete
currentSht.Range("A:D").Columns.AutoFit
For j = lastRow To 2 Step -1
If currentSht.Cells(j, "B").Value <> "" Then
currentSht.Range(Cells(j, "B").Offset(-1), Cells(j, "B").Offset(-3)).EntireRow.Delete
End If
Next j
End Sub
Thank you
The second loop deletes everything because upon deletion of the lines above the found value, said value gets moved up and will be found again, triggering another deletion. To fix this, the quickest way would be to skip the next two lines by modifying j:
For j = lastRow To 2 Step -1
If currentSht.Cells(j, "B").Value <> "" Then
currentSht.Range(Cells(j, "B").Offset(-1), Cells(j, "B").Offset(-3)).EntireRow.Delete
j = j - 2
End If
Next j
It really doesn't matter much if you are looping from top to bottom or vice versa. The only difference would be if there are two entries in column B near each other. In that case, the search order would determine which one is deleted. But is deletion really what you want? Maybe you could .Clear the contents of the rows instead of deleting them.
edit: here's the new code a bit cleaned up
Sub test()
Dim currentSht As Worksheet
Dim startCell As Range
Dim lastRow As Long, lastCol As Long
Dim colNames As Variant
Dim i As Integer, j As Integer
Set currentSht = ActiveWorkbook.Sheets(1)
Set startCell = currentSht.Range("A1")
lastRow = startCell.SpecialCells(xlCellTypeLastCell).Row
lastCol = startCell.SpecialCells(xlCellTypeLastCell).Column
For i = lastRow To 1 Step -1
If currentSht.Cells(i, "B").value <> "" Then
'reference the row directly
currentSht.Rows(i + 1).Delete
End If
Next i
'Do not use selection if you can avoid it
Range("D3", Range("D3").End(xlToRight)).Delete Shift:=xlUp
currentSht.Rows(1).Delete
currentSht.Range("C:D, F:G, I:K").Delete
currentSht.Range("A:D").Columns.AutoFit
For j = lastRow To 2 Step -1
If currentSht.Cells(j, "B").value <> "" Then
currentSht.Rows(j - 1).Delete
currentSht.Rows(j - 2).Delete
j = j - 2
End If
Next j
End Sub
If you want to combine the loops the behavior of the macro will change because of the deletions that happen between the loops.
I am trying to write a vba code to get rid of a row if any word is immediately repeated in same column (column E) but in other row. If that happens, the row to be deleted is the one more on top. Follow an example below. In this case, the row to be dropped are: E6, E10 and E15.
Name of the sheet is test. Columns and F and G are not relevant.
Thanks a lot!
Edit to add code from comments:
Sub delete_duplicates_column_E()
With Sheets("test").Range("A:E")
.Value = .Value
.RemoveDuplicates Columns:=5, Header:=xlYes
End With
End Sub
Just whipped this up, try it:
Sub removeDuplicates()
Range("E2").Select
Do Until ActiveCell.Value = ""
If ActiveCell.Value = ActiveCell.Offset(1).Value Then
ActiveCell.EntireRow.Delete (xlShiftUp)
End If
ActiveCell.Offset(1).Select
Loop
End Sub
When deleting rows it is better to loop back wards:
Sub delete_duplicates_column_E()
Dim ws As Worksheet
Dim lastrow As Long
Dim i As Long
Set ws = Sheets("test")
With ws
lastrow = .Range("E" & .Rows.Count).End(xlUp).Row
For i = lastrow To 2 Step -1
If .Cells(i, 5) = .Cells(i + 1, 5) Then
.Rows(i).Delete
End If
Next i
End With
End Sub
I need your help with conditional Vlookup. I found a code that works fine if there is vlookup value in the source data but it fails once there is a missing value. Also I need to add a condition ('If the value is found by Lookup, then return "Old" (from 2nd column in vlookup table)
'If the value is NOT found, then return "New" (just text which is not coming from vlookup table). Could you help me?
Thank you,'Russ
Sub Vlookup_Condition()
Dim rng As Range
Dim i As Long
With ActiveSheet.Cells
Set rng = .Range("A1:A" & .Cells(.Rows.count, 1).End(xlUp).row)
For i = 2 To rng.Rows.count
'If the value is found by Lookup, then return "Old" (from 2nd column in vlookup table)
'If the value is NOT found, then return "New" (just text which is not coming from vlookup
'table)
rng.Cells(i, 2) = Application.WorksheetFunction.VLookup(.Cells(i, 1), Sheets("Lookuptable").Range("A:B"), 2, False)
Next
End With
End Sub
As per your puzzle. I found a solution like this Russ
UPDATED & TESTED
Sub Vlookup_Condition()
Dim rng As Range
Dim i As Long
Application.ScreenUpdating = False
Worksheets("DataFile").Activate
Range("R2").Activate
With Worksheets("DataFile").Cells
Set rng = .Range("O1:O" & .Cells(.Rows.count, 1).End(xlUp).row)
For i = 2 To rng.Rows.count
rng.Cells(i, 4) = Application.VLookup(.Cells(i, 15), Sheets("Lookuptable").Range("A:B"), 2, False)
If IsError(rng.Cells(i, 4)) Then
If rng.Cells(i, 4) = CVErr(xlErrNA) Then ' Given if condition to change it from "#NA" to "New"
rng.Cells(i, 4) = "New"
End If
End If
Next
End With
Application.ScreenUpdating = True
End Sub
Try this
Sub Vlookup_Condition()
Dim rng As Range
Dim ws as Worksheet
Dim i As Long
Set ws = ActiveSheet
i =2
With ws.Range("A1:A" & Rows.Count)
.Formula = "=VLookup(" & ws.Cells(2,1).Address & ",Lookuptable!$A:$B,2,false)"
End With
Do while ws.Cells(i, 1) <> ""
if ws.Cells(i,2) <> "OLD" Then ws.Cells(i,2) = "New"
i = i +1
Loop
Hope this helps there is a more concise way to do this but this way might be easier to build off of.
Ok after further review TRY THIS! lol
With ActiveSheet
Set rng = .Range("A1:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
For i = 2 to rng.Rows.Count
rng.Cells(i, 2) = Application.WorksheetFunction.VLookup(ActiveSheet.Cells(i,1), Sheets("Lookuptable").Range("A:B"), 2, False)
Next
End With
End Sub
I really hope this works for ya mate if not ill probably not do any actual work AT work tomorrow until i figure out how i totally punted this help lol