VBA Help - Deleting Certain Values From Rows

Pineapple_Crazy

Board Regular
Joined
May 2, 2017
Messages
51
Hey Everyone,

Looking for some VBA help here. Basically I have this disgusting looking output from one of our management systems. I have created code to clean the data up into a presentable table format that can be utilized to draw some analysis. However, in doing so I have brought certain values into the data set rows that I would like to remove. I've developed some code to do so, shown below, but it is incredibly slow and it doesn't remove all the values at once (not really sure why?). Therefore, I need to loop through the code like 5 times in order to remove all the values I need removed. Can someone provide some assistance on how to improve this code and maybe get away from the looping? Thanks much!


Code:
Sub Find_Values_Delete()

Dim Mycell As Range
Let x = 0
Do While x < 5


Application.DisplayAlerts = False
Application.ScreenUpdating = False
    
    
For Each Mycell In Range("A1:AM100000")
    
    If Mycell.Value = "Account #:" Then
        Mycell.Delete Shift:=xlToLeft
    End If
    
    If Mycell.Value = "1099:" Then
        Mycell.Delete Shift:=xlToLeft
    End If
        
    If Mycell.Value = "SSN:" Then
        Mycell.Delete Shift:=xlToLeft
    End If
          
    If Mycell.Value = "Tax ID:" Then
        Mycell.Delete Shift:=xlToLeft
    End If
    
    If Mycell.Value = "Null" Then
        Mycell.Delete Shift:=xlToLeft
    End If
    


Next
 x = x + 1
 
Loop




Application.ScreenUpdating = True
Application.DisplayAlerts = True


End Sub
 

Some videos you may like

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

Leith Ross

Well-known Member
Joined
Mar 17, 2008
Messages
1,874
Office Version
2010, 2007
Platform
Windows
Hello Pineapple_Crazy,

Do the cells only contain values like "Account #:", "1099:", etc.? Or is there other information following like "Account #: 12345"?
 

Pineapple_Crazy

Board Regular
Joined
May 2, 2017
Messages
51
Hello Pineapple_Crazy,

Do the cells only contain values like "Account #:", "1099:", etc.? Or is there other information following like "Account #: 12345"?

Hi Leith,

Yes, it only contains those specific values, like "Account #:", "Null", etc. It deletes them like I want, but is very slow and I have to loop through the code at least five times to remove them all. Don't know why.

Thanks!
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
53,065
Office Version
365
Platform
Windows
It deletes them like I want, but is very slow and I have to loop through the code at least five times to remove them all. Don't know why.
It is because it is looping through the cells in order from left-to-right. The issue is that you are deleting the cells and shifting them left.

Think about it. Let's say that both cells A1 and B1 should be deleted.
As you go through your loop, when you hit A1, you delete that value. Now the value from B1 moves to cell A1. But you aren't going to hit cell A1 again in your loop (since you already did that cell!).
So you typically want to loop in the other directions, but you can do that by using "for each cell in range..." type loops.

Also, is your data always going to end in AM100000? If not, you are doing some unnecessary looping. You can dynamically find the last cell you need to go to, and tell the code to stop there.
Can you explain the logic on where we can find the last cell? Is there one column that is always populated (like column A)? Will that data always go out to column AM?

You might even be able to avoid loops altogether. Are there any blanks within your data? If not, we may be able to replace all the values you are looking for with blanks, then delete all the blanks at once.
 

Pineapple_Crazy

Board Regular
Joined
May 2, 2017
Messages
51
It is because it is looping through the cells in order from left-to-right. The issue is that you are deleting the cells and shifting them left.

Think about it. Let's say that both cells A1 and B1 should be deleted.
As you go through your loop, when you hit A1, you delete that value. Now the value from B1 moves to cell A1. But you aren't going to hit cell A1 again in your loop (since you already did that cell!).
So you typically want to loop in the other directions, but you can do that by using "for each cell in range..." type loops.

Also, is your data always going to end in AM100000? If not, you are doing some unnecessary looping. You can dynamically find the last cell you need to go to, and tell the code to stop there.
Can you explain the logic on where we can find the last cell? Is there one column that is always populated (like column A)? Will that data always go out to column AM?

You might even be able to avoid loops altogether. Are there any blanks within your data? If not, we may be able to replace all the values you are looking for with blanks, then delete all the blanks at once.
Hi Joe,

That makes a lot of sense thanks! Column A will always have data in it and there will never be any blanks through column AM. So what do you suggest?

Thanks!
 

Pineapple_Crazy

Board Regular
Joined
May 2, 2017
Messages
51
Joe,

This definitely helps! I'd like to see your solution though with replacing blanks.

Thanks!

Code:
Sub Find_Values_Delete()



[B]Dim lastRow As Long[/B]
[B]lastRow = Range("A" & Rows.Count).End(xlUp).Row[/B]


Dim Mycell As Range
Let x = 0
Do While x < 5


Application.DisplayAlerts = False
Application.ScreenUpdating = False
    
    
For Each Mycell In Range("A1:AM" &[B] lastRow[/B])
    
    If Mycell.Value = "Account #:" Then
        Mycell.Delete Shift:=xlToLeft
    End If
    
    If Mycell.Value = "1099:" Then
        Mycell.Delete Shift:=xlToLeft
    End If
        
    If Mycell.Value = "SSN:" Then
        Mycell.Delete Shift:=xlToLeft
    End If
          
    If Mycell.Value = "Tax ID:" Then
        Mycell.Delete Shift:=xlToLeft
    End If
    
     If Mycell.Value = "Null" Then
        Mycell.Delete Shift:=xlToLeft
    End If
    
  


Next
 x = x + 1
 
Loop




Application.ScreenUpdating = True
Application.DisplayAlerts = True


End Sub
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
53,065
Office Version
365
Platform
Windows
Try this (no loops!):
Code:
Sub MyDeleteMacro()

    Dim lastRow As Long
    Dim dataRange As Range
    Dim rep() As Variant
    Dim i As Long

'   Set values to delete
    rep = Array("Account #:", "1099:", "SSN:", "Tax ID:", "Null")
    
    Application.ScreenUpdating = False
    
'   Find last row by looking at last row with data in column A
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
'   Set range to check against
    Set dataRange = Range("A1:AM" & lastRow)
    
'   Loop through all values to replace
    For i = LBound(rep) To UBound(rep)
        dataRange.Replace What:=rep(i), Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Next i
    
'   Delete all blanks
    dataRange.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft
    
    Application.ScreenUpdating = True
    
End Sub
 

Pineapple_Crazy

Board Regular
Joined
May 2, 2017
Messages
51
Try this (no loops!):
Code:
Sub MyDeleteMacro()

    Dim lastRow As Long
    Dim dataRange As Range
    Dim rep() As Variant
    Dim i As Long

'   Set values to delete
    rep = Array("Account #:", "1099:", "SSN:", "Tax ID:", "Null")
    
    Application.ScreenUpdating = False
    
'   Find last row by looking at last row with data in column A
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
'   Set range to check against
    Set dataRange = Range("A1:AM" & lastRow)
    
'   Loop through all values to replace
    For i = LBound(rep) To UBound(rep)
        dataRange.Replace What:=rep(i), Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Next i
    
'   Delete all blanks
    dataRange.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft
    
    Application.ScreenUpdating = True
    
End Sub

Joe that is beautiful!! Never thought about using an array!!! Awesome man, thank you, thank you! :)
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
53,065
Office Version
365
Platform
Windows
You are welcome.
Glad I was able to help!:)
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
35,817
Office Version
2010
Platform
Windows
Try this (no loops!):
Code:
'   Loop through all values to replace
    [B][COLOR="#FF0000"]For[/COLOR][/B] i = LBound(rep) To UBound(rep)
        dataRange.Replace What:=rep(i), Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    [B][COLOR="#FF0000"]Next[/COLOR][/B] i
No loops, really? :devilish:
 

Watch MrExcel Video

Forum statistics

Threads
1,095,982
Messages
5,447,691
Members
405,463
Latest member
Tommy5

This Week's Hot Topics

Top