VBA to automate formatting

[ChrisS92]

Hello,

I have a particular set of data:

AA
BB
AB
CC
CA
CD
DA
FA
FD
FC

I want to create an if/then statement to delete all values that contain either an "A" or a "D" for purposes of eliminating irrelevant data. Sometimes I'll have more values, sometimes less, but I always want the same conditions for the clean up to apply. What would the code look like?

Thanks in advance!

 

[igold]

This will find cells in Column G and delete just the cell and shift up, you did not say whether you wanted the entire row deleted or just the cell.

Sub findletters_AD()

    Dim L1 As String
    Dim L2 As String
    Dim x As Integer
    Dim i As Integer
    Dim LR As Long
    
'Find the last used row in column G
    With ActiveSheet
        LR = .Cells(.Rows.Count, "G").End(xlUp).Row
    End With

    For i = 1 To LR
    
skip:
        Range("G" & i).Select
        L1 = Left(ActiveCell, 1)
        L2 = Mid(ActiveCell, 2)
            If L1 = "A" Or L2 = "A" Then
                ActiveCell.Delete
                GoTo skip
            End If
            If L1 = "D" Or L2 = "D" Then
                ActiveCell.Delete
                GoTo skip
            End If
    Next

End Sub

HTH

igold

 

[MARK858]

@igold and ChrisS92

For i = 1 To LR

needs to be

For i = LR To 1

if you are deleting with a loop i.e. from the bottom of the sheet to the top or it will miss rows.

There is also no need to activate cells to work with them.

 

[MARK858]

An adaption of the code in post #2

Sub findletters_AD()

    Dim L1 As String
    Dim L2 As String
    Dim x As Long
    Dim i As Long
    Dim LR As Long

    'Find the last used row in column G
    With ActiveSheet
        LR = .Cells(.Rows.Count, "G").End(xlUp).Row

For i = LR To 1 Step -1

            L1 = Left(.Range("G" & i), 1)
            L2 = Mid(.Range("G" & i), 2, 1)
            
            If L1 = "A" Or L2 = "A" Then
                .Range("G" & i).Delete
            ElseIf L1 = "D" Or L2 = "D" Then
                .Range("G" & i).Delete
            End If
        Next
    End With
End Sub

and a different method using Column C

Sub DelArray()
    Dim rFnd As Range, dRng As Range, rFst As String, vList, ArrCnt As Long
    vList = Array("*A*", "*D*")

    For ArrCnt = LBound(vList) To UBound(vList)
        With Range("C2:C" & Range("C" & Rows.Count).End(xlUp).Row)
            Set rFnd = .Find(What:=vList(ArrCnt), _
                             LookIn:=xlValues, _
                             LookAt:=xlPart, _
                             SearchOrder:=xlByRows, _
                             SearchDirection:=xlNext, _
                             MatchCase:=False)

            If Not rFnd Is Nothing Then
                
                rFst = rFnd.Address
                Do
                    If dRng Is Nothing Then
                        Set dRng = Range("C" & rFnd.Row)
                    Else
                        Set dRng = Union(dRng, Range("C" & rFnd.Row))
                    End If
                    
                    Set rFnd = .FindNext(After:=rFnd)
                
                Loop Until rFnd.Address = rFst
            End If
            
            Set rFnd = Nothing
        End With
    Next ArrCnt
    
    If Not dRng Is Nothing Then dRng.Delete

End Sub

both can have screenupdating set to False if desired

 

[igold]

MARK858,

Clearly your way is cleaner I did not think about starting at the bottom. However my way does not skip rows.

igold

 

[MARK858]

However my way does not skip rows.

That'll teach me not to run the code because you have put the extra loops in by using Goto you are right it doesn't skip the rows so my apologies for that incorrect statement.

But making it loop extra times still isn't an efficient of achieving the task and neither is selecting/activating the cells.

 

[Rick Rothstein]

You can also do this without looping. Using Column G as the column containing the letter codes...

Sub findletters_AD()
  Application.ScreenUpdating = False
  With Range("[B][COLOR="#0000FF"]G[/COLOR][/B]1", Cells(Rows.Count, "[B][COLOR="#0000FF"]G[/COLOR][/B]").End(xlUp))
    .Replace "*A*", "", xlWhole
    .Replace "*D*", "", xlWhole
    On Error GoTo NoBlanks
     .SpecialCells(xlBlanks).Delete xlShiftUp
  End With
NoBlanks:
  Application.ScreenUpdating = True
End Sub

 

[MARK858]

Rick, the thing I find interesting is over the small data set I am using (the OP's original data copied 11 times) the code you posted runs quicker consistently with the screenupdating on rather than off (only by approx. 0.05 milliseconds but it seems consistent over 7 runs)

 

[Rick Rothstein]

Rick, the thing I find interesting is over the small data set I am using (the OP's original data copied 11 times) the code you posted runs quicker consistently with the screenupdating on rather than off (only by approx. 0.05 milliseconds but it seems consistent over 7 runs)

Maybe there is a minor time penalty associated with whatever underlying "set up" Excel has to do to turn screen updating off and that time penalty becomes "seeable' when there is not a lot of items to process... the main reason for turning screen updating off is because of the time it takes for Excel to update the screen during a large looping process, not a small one like sample data tends to be. With that said, I don't think someone watching would notice a 0.05 millisecond (are you sure that is not 0.05 seconds?) delay.

 

[MARK858]

0.05 millisecond (are you sure that is not 0.05 seconds?

No definitely milliseconds (the code took between 39 & 44 milliseconds in total each run with screenupdating on (the array code I used earlier in thread is roughly 5 milliseconds each run slower with screenupdating off (which is about 5 milliseconds faster than having it off)).

I didn't expect much difference because as you stated screenupdating is most effective against looping cells and so I only expected a slight difference as both your code and my array code delete in one go but I did expect having screenupdating off to be slightly faster in both codes not in one code being the other way round.

Just a bit intrigued

Timings were done using FastExcel V3