Posts by _Frost_

Quote from Carim

Glad we are progressing ...

To take into account your two latest requests ...

Code

Sub RemoveAllCodes()
Dim lastrow As Long, lastrowK As Long, c As Range, rngK As Range
Dim res As Variant
lastrow = Sheets("Import Data").Cells(Rows.Count, 1).End(xlUp).row
lastrowK = Sheets("Drivers").Cells(Rows.Count, 11).End(xlUp).row
Set rngK = Sheets("Drivers").Range("K35:K" & lastrowK)


Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each c In rngK
res = Application.Match(c.Value, Sheets("Import Data").Range("F1:F" & lastrow), 0)
If Not IsError(res) Then
Sheets("Import Data").AutoFilterMode = False
' ''''''''''MAKE SURE TO ADJUST THE RANGE TO YOUR ACTUAL SITUATION '''''''''''''''''''''''''''
With Sheets("Import Data").Range("A1:M" & lastrow)
.AutoFilter Field:=6, Criteria1:="=" & c.Value
.Offset(1, 0).Resize(lastrow - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
End If
Next c
' Back to Normal
Sheets("Import Data").AutoFilterMode = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox " All Codes have been Removed ..."
End Sub

Display More

Hope this will be fine ...

Display More

Hi,

That is absolutely perfect, thank you.

Quote from Carim

Hi again,

Glad to hear we are heading in the right direction ...

Code

Sub RemoveCodes()
' Sheets("Drivers")
' Sheets("Import Data")


Dim lastrow As Long, lastrowK As Long, c As Range, rngK As Range
lastrow = Sheets("Import Data").Cells(Rows.Count, 1).End(xlUp).Row
lastrowK = Sheets("Drivers").Cells(Rows.Count, 11).End(xlUp).Row
Set rngK = Sheets("Drivers").Range("K35:K" & lastrowK)


Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each c In rngK
Sheets("Import Data").AutoFilterMode = False
' ''''''''''MAKE SURE TO ADJUST THE RANGE TO YOUR ACTUAL SITUATION '''''''''''''''''''''''''''
With Sheets("Import Data").Range("A1:M" & lastrow)
.AutoFilter Field:=6, Criteria1:="=" & c.Value
.Offset(1, 0).Resize(lastrow - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
Next c
' Back to Normal
Sheets("Import Data").AutoFilterMode = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Display More

Hope this corresponds to your actual situation

Display More

That worked an absolute treat, thank you. Is there a way to add some sort of error correction so if one value doesn't exist then it would skip it rather than crash the macro?

Also I know there is a very simple way to add a pop up message at the end of the macro however I don't remember from years ago when I learned. Could you drop a line at the end of the macro to add a pop up box with a message saying "Complete"?

Quote from Carim

Hi,

Thanks for attaching a sample file with your next message ...

Probably one of the codes in your K range ... does not appear at all ... :wink:

I took a look through and realised where its going wrong. The list of values I want to filter against is on a sheet called Drivers and the data I want to delete rows from is on a sheet called Import Data on the same file.

Is there a way to have it switch between the sheets? I want to run the macro from the Driver sheet with the criteria values on it.

Quote from Carim

Hi,

You could test the following macro ... on a copy of your actual workbook ...

Code

Sub RemoveCodes()


Dim lastrow As Long, lastrowK As Long, c As Range, rngK As Range
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
lastrowK = Cells(Rows.Count, 11).End(xlUp).Row
Set rngK = Range("K35:K" & lastrowK)


Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each c In rngK
ActiveSheet.AutoFilterMode = False
' ''''''''''MAKE SURE TO ADJUST THE RANGE TO YOUR ACTUAL SITUATION '''''''''''''''''''''''''''
With ActiveSheet.Range("A1:M" & lastrow)
.AutoFilter Field:=6, Criteria1:="=" & c.Value
.Offset(1, 0).Resize(lastrow - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
Next c
' Back to Normal
ActiveSheet.AutoFilterMode = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Display More

Hope this will help

Display More

Hi,

Thank you, I am getting a Runtime 1004 error on this row : .Offset(1, 0).Resize(lastrow - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete

Any idea on what it could be?

Hi all,

I have this macro below which might not be the fastest but seems to work pretty well. I need some help on having it pick up value criteria from a table rather than manually inputting it as I have currently 20 that I need to search for and delete and might have some more so ideally something where it can pick up a larger list and then search for true values within the list that would be ideal. Currently I have the list of values I want to search for to delete rows that include that value, they are on K16 to K35 but I might expand the list so if its possible to do up to for e.g. K40 and search for true values in the list that would be ideal.

I also have the list on a different sheet caller Drivers and the dataset I want to remove values from is called Import Data, I want to be able to run the macro from the Drivers page from a button so I also need a line adding to do the search on the Import Data page rather than the active sheet.

Can someone thing of an easy solution for this either adding in a couple of lines or if its easier then doing the macro a different way?

Thanks in advance.

Sub RemoveCode()


    Dim x As Long, lastrow As Long
    lastrow = Cells(Rows.Count, 1).End(xlUp).Row
    For x = lastrow To 1 Step -1
        If Cells(x, 6).Value = "XXXX" Then
            Rows(x).Delete
        End If
    Next x


End Sub

Hi all,

I have this macro below which might not be the fastest but seems to work pretty well. I need some help on having it pick up value criteria from a table rather than manually inputting it as I have currently 20 that I need to search for and delete and might have some more so ideally something where it can pick up a larger list and then search for true values within the list that would be ideal. Currently I have the list of values I want to search for to delete rows that include that value, they are on K16 to K35 but I might expand the list so if its possible to do up to for e.g. K40 and search for true values in the list that would be ideal.

I also have the list on a different sheet caller Drivers and the dataset I want to remove values from is called Import Data, I want to be able to run the macro from the Drivers page from a button so I also need a line adding to do the search on the Import Data page rather than the active sheet.

Can someone thing of an easy solution for this either adding in a couple of lines or if its easier then doing the macro a different way?

Thanks in advance.

Sub RemoveCode()

Dim x As Long, lastrow As Long
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For x = lastrow To 1 Step -1
If Cells(x, 6).Value = "XXXX" Then
Rows(x).Delete
End If
Next x

End Sub

Hi all,

I have this macro below which might not be the fastest but seems to work pretty well. I need some help on having it pick up value criteria from a table rather than manually inputting it as I have currently 20 that I need to search for and delete and might have some more so ideally something where it can pick up a larger list and then search for true values within the list that would be ideal. Currently I have the list of values I want to search for to delete rows that include that value, they are on K16 to K35 but I might expand the list so if its possible to do up to for e.g. K40 and search for true values in the list that would be ideal.

I also have the list on a different sheet caller Drivers and the dataset I want to remove values from is called Import Data, I want to be able to run the macro from the Drivers page from a button so I also need a line adding to do the search on the Import Data page rather than the active sheet.

Can someone thing of an easy solution for this either adding in a couple of lines or if its easier then doing the macro a different way?

Thanks in advance.

Sub RemoveCode()
Dim x As Long, lastrow As Long
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For x = lastrow To 1 Step -1
If Cells(x, 6).Value = "XXXX" Then
Rows(x).Delete
End If
Next x
End Sub

Quote from Carim

Hi,

If your objective is consistently to get the first 12 digits ...

Code

=left(A1,12)

should do the job ...

But if the length before the second [SIZE=18px]-[/SIZE] can fluctuate ... you should test :

Code

=LEFT(A1,IFERROR(FIND(CHAR(1),SUBSTITUTE(A1,"-",CHAR(1),2)),"")+1)

Hope this will help

Display More

The length fluctuates but the second formula works perfectly, thank you.

Hi all,

I am trying to create a formula where depending on what the ending of the value in the cell is, it deletes 1 or 2 of the last characters.

For example I could have two different codes such as:

AB12-34567-ABC
AB12-34567-AB

I want to make a formula that will remove either 1 or two of the last characters to turn it into AB12-34567-A regardless of if there is 2 or 3 characters after the last -

The only problem is these codes are very inconsistent in length before the last - so I can't just do a simple length counting and then using that unless there is a way to count what's after the last - as that is the only thing that stays consistent in the code.

The only thing I have managed to get sort of working is I can do a =COUNTIF(A2,"*-???") and then if it counts it then you do the =IF(B2=1,LEFT(A2,LEN(A2)-2),LEFT(A2,LEN(A2)-1))

Now combining the two formulas does work to get =IF(COUNTIF(A2,"*-???")=1,LEFT(A2,LEN(A2)-2),LEFT(A2,LEN(A2)-1)) but it looks a bit messy to me and I am sure there is a neater way of doing this with a formula, I can do it on a macro however that isn't suitable for my needs so ideally a single formula would be great.

Thanks in advance.

Quote from Mumps

Try:

Code

Sub DeleteRows()
Application.ScreenUpdating = False
Dim bRow As Long, aRow As Long
Dim counter As Long
bRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Sheets("Sheet1").Cells.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7), Header:=xlYes
aRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
counter = bRow - aRow
MsgBox (counter & " rows were deleted.")
Application.ScreenUpdating = True
End Sub

Display More

That is perfect thank you, you are an absolute genius. Everything I have tried before was super slow and would take ages but this is just fantastic.

Is there a way to adapt this code so it only counts the duplicates without deleting them too?

Quote from Mumps

Try on a copy of your file:

Code

Sub DeleteRows()
Application.ScreenUpdating = False
Sheets("Sheet1").Cells.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7), Header:=xlYes
Application.ScreenUpdating = True
End Sub

That code works like a charm. Really fast and efficient, thank you.

Is there a way it can also count the number of rows being deleted?

Hi ladies and gents,

I have this task I am working on where I have a data set of around 58,00 rows and 21 columns.

My task is to count and delete any duplicate rows. The rows need to match the previous row in columns 1, 2, 3, 4, 5, 6 and 7.

I have looked around and have found lots of VBA codes which work great but only check over a single column.

I have also done it the COUNTIFS way which works but it a little messy for my liking.

I know there is a Remove Duplicates function in excel but I need it to output the total number of duplicates into a cell.

Also since its quiet a large macro, a status bar would also be great just to know where its up to.

Any help, idea or even a link to a thread that's relevant would be greatly appreciated.