Struggling to create a loop in VBA

spidaman

Board Regular
Joined
Jul 26, 2015
Messages
116
Office Version
  1. 365
Platform
  1. Windows
Hi

I'm very new to vba and am struggling with getting an if/then to loop throughout the worksheet. With the below code I'd like to find the next "yes" after the first one in the D column and then each and every "yes" in the D column throughout the active worksheet acting on each one. Then to end the sub after the final row. The individual if/elseif commands seem to work ok by themselves but I have made numerous attempts at the loop/findnext for it to run throughout without success :mad:. I've now taken out my attempt at the loop. Can anyone have a look please and help me construct the loop? I expect there may be other errors as well.

Sub_CDA_v1()

Dim oRange As Range
Dim SearchString As String

Set oRange = ActiveSheet.Columns("D:D")
SearchString = "yes"
Set aCell = oRange.Find(What:=SearchString, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Set bCell = aCell.Offset(0, 1)
Set cCell = bCell.Offset(-1, 0)
Set dCell = bCell.Offset(0, 1)
Set eCell = cCell.Offset(0, 1)
Set fCell = bCell.Offset(0, 2)
Set gCell = cCell.Offset(0, 2)
Set hCell = fCell.Offset(0, 3)
Set iCell = gCell.Offset(0, 3)
Set jCell = aCell.Offset(-1, 0)
Set kCell = hCell.Offset(0, 1)
Set lCell = iCell.Offset(0, 1)

[/INDENT]If dCell = eCell And fCell = gCell And bCell = "Calls Forwarded" And cCell = "Voice Calls Terminating" Then
[/INDENT]bCell.Select
Selection.Copy
cCell.Select
ActiveSheet.Paste
hCell.Select
Selection.Copy
iCell.Select
ActiveSheet.Paste
kCell.Select
Selection.Copy
lCell.Select
ActiveSheet.Paste
bCell.Select
Rows(ActiveCell.Row).EntireRow.Delete​
[/INDENT]
ElseIf dCell = eCell And fCell = gCell And bCell = "Calls Forwarded" And cCell = "Voice Calls Originating" Then
bCell.Select
Selection.Copy
cCell.Select
ActiveSheet.Paste
hCell.Select
Selection.Copy
iCell.Select
ActiveSheet.Paste
kCell.Select
Selection.Copy
lCell.Select
ActiveSheet.Paste
bCell.Select
Rows(ActiveCell.Row).EntireRow.Delete

ElseIf dCell = eCell And fCell = gCell And bCell = "Voice Calls Originating" And cCell = "Calls Forwarded" Then
cCell.Select
Selection.Copy
bCell.Select
ActiveSheet.Paste
iCell.Select
Selection.Copy
hCell.Select
ActiveSheet.Paste
lCell.Select
Selection.Copy
kCell.Select
ActiveSheet.Paste
jCell.Select
Selection.Copy
aCell.Select
ActiveSheet.Paste
cCell.Select
Rows(ActiveCell.Row).EntireRow.Delete

ElseIf dCell <> eCell Then

ElseIf fCell <> gCell Then

End If

End Sub​
 
If you want to post code, find a computer. it makes everyone happy.

For the EZ stuff. The section that says "Just for testing', is for testing the logic of the Sub. As you're a jr. programer I wanted you to see that the process is finding all the cells with 'Yes" by displaying a message box of how many times the 'Yes' was found and also show the cell addresses of those found. Its just for you to see the results of the .Find is in fact working. For your final program you would just delete these lines related to testing string and the 'msgbox' statements at the bottom.

Now onto the tuff stuff.
The code I posted before will work great if you are doing stuff that does not involve deleting rows. At 2am I missed the fact that you are not only shifting values but are also deleting the 'YES' row afterwards.
Because of this, the previous code will not work for this particular need. (keep it though, because it will work for almost any other 'Search and Do Stuff' processes you may have in the future.

Here is the replacement code that works when rows may be deleted in your spreadsheet.
I put comments throughout to help explain whats happening. If not for the comments this is a short chunk of code compared to your original.

It has the modified CDA_v2 SUB
And I also created another SUB (called WorkTheCallData) that took your IF..ElseIF..End IF and cleaned it up. It is much more readable and the logic is easier to follow. That Said, I think you need to take a close look at the logic of the RULES applied to the cell copy and row delete. Often is the case, creating big nested IF statements are very hard to follow and prone to errors in logic. I did leave the crazy range names as I found them (in your IF..Else..End If) so you will still have the same cell references you've been working with. The a,b,c Cell Range NAMES should eventually be changed to variables that make the code more readable. You are already struggling with the code so don't do it now.

Paste both of these subs in your worksheet Code.
You will see in the CDA_v2 SUB, that the WorkTheCallData)is called in the section for 'Do stuff here' just below the 'Just testing'.
So you will only call the CDA_v2 SUB when you want to modify your Phone Call Log.

It should function as far as finding the 'Yes', and applying your logic rules. I know almost nothing about the content of your spreadsheet or all the rules, so only you can verify if the rules are correct.

Make sure if you have a CDA_v2 SUB already, be sure to rename it so it doesn't conflict with this good code.
Paste this into the worksheet's code window and run CDA_v2 SUB. Let me know how it goes.
Code:
Sub CDA_v2()
Dim oRange As Range, foundCell As Range
Dim FirstFoundCell As String, SearchString As String, FoundAt As String
Dim iCount As Integer
    
    SearchString = "YES"
    Set oRange = ActiveSheet.Columns("D:D")
    
    Set foundCell = oRange.Find(What:=SearchString, LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
    MatchCase:=False, SearchFormat:=False)
    
    If Not foundCell Is Nothing Then
        
        Do Until foundCell Is Nothing
            LastFoundCell = foundCell.Address
            '================================================================================
            'Do stuff here when the search returns a Cell with a match to your SearchString.
            '================================================================================
            'just for testing.
            FoundAt = FoundAt & foundCell.Address & ", " 'String the addresses together
            iCount = iCount + 1 'Let's keep count of how many we find.
            'End testing.
            
            'Actual Sub that will analyse your call log data.
            Call WorkTheCallData(foundCell)
            '================================================================================
            
            ' Lets see if there is more...
            Set foundCell = oRange.FindNext
            ' See if we looped back to the previous cell.
            ' If we did then we are finished searching
            ' However the DoSomeWork sub actually deletes the found row if the logic is correct
            ' so the original find might have been deleted in its process. So just check for nothing on
            ' subsequent .Finds
            If Not foundCell Is Nothing Then If foundCell.Address = LastFoundCell Then Set foundCell = Nothing
        Loop
        
        '==========================================================================
        ' We get here after we have found all matches to our SearchString
        '==========================================================================
        FoundAt = Trim(FoundAt)
        FoundAt = Left(FoundAt, Len(FoundAt) - 1)
        MsgBox "Number of times we found it: " & iCount & vbCrLf & FoundAt, vbOKOnly, "Finished!"
        
    Else
        '==========================================================================
        'NEVER found the SearchString.
        'If you need to do something when not found, do it here. If not,leave this empty.
        '==========================================================================
        MsgBox "Got Nothing...", vbOKOnly, "Finished..."
        
        '==========================================================================
    End If
End Sub


Sub WorkTheCallData(MyYesCell As Range)
'=================================================
' MyYesCell is the D column cell with 'YES' in it.
'=================================================
Dim bCell As Range, cCell As Range, dCell As Range, eCell As Range, fCell As Range
Dim gCell As Range, hCell As Range, iCell As Range, jCell As Range, kCell As Range, lCell As Range
Dim sCallType As String
    ' =====================================================================================
    ' I know nothing about the data in most of your cells. So DOUBLE CHECK your logic
    ' on your Phone Call Log processes to be sure its shifting data as you need.
    ' Even though I don't have all the specifics, your logic may be flawed for your intent.
    ' Just check it to make sure it is doing what you want based on your process rules.
    ' =====================================================================================
    ' Would be nice if the a,b,c ranges acutally related to their respective column letters and offset.
    ' but lets just go with what you have for now.
    ' =====================================================================================
    
    Set bCell = MyYesCell.Offset(0, 1) ' bCell is column E on row with 'YES'.
    
    ' =====================================================================================
    ' Note that You had the cCell below, being set to a negative row offset.
    ' This will fail if 'Yes' is ever found in row 1 of column D. ie row1 -1 equals row0
    ' If D1 will NEVER, EVER possibly have the value of 'YES' then this will be fine.
    ' Otherwise some code should be added to check if the 'YES' is found on row1.
    ' =====================================================================================
    Set cCell = bCell.Offset(-1, 0) ' cCell is column E cell with a -1 row from 'Yes'
    Set dCell = bCell.Offset(0, 1)  ' dCell is column F cell on row with 'YES'.
    Set eCell = cCell.Offset(0, 1)  ' eCell is column F cell with a -1 row from 'Yes'
    Set fCell = bCell.Offset(0, 2)  ' fCell is column G cell on row with 'YES'.
    Set gCell = cCell.Offset(0, 2)  ' gCell is column G cell with a -1 row from 'Yes'
    Set hCell = fCell.Offset(0, 3)  ' hCell is column J cell on row with 'YES'.
    Set iCell = gCell.Offset(0, 3)  ' iCell is column J cell with a -1 row from 'Yes'
    
    ' =====================================================================================
    ' Note that You had the jCell below, being set to a negative row offset.
    ' SAME ISSUE AS cCell LOGIC ABOVE.
    ' =====================================================================================
    Set jCell = MyYesCell.Offset(-1, 0) ' jCell is column D cell with a -1 row from 'Yes'
    Set kCell = hCell.Offset(0, 1)  ' kCell is column K cell on row with 'YES'.
    Set lCell = iCell.Offset(0, 1)  ' lCell is column K cell with a -1 row from 'Yes'
    
    If (dCell = eCell) And (fCell = gCell) Then
        '====================================================================================
        ' We fall in here IF:
        ' The Value in column F:on foundrow is the same as the Value in column F:-1row above it.
        ' AND
        ' The Value in column G:on foundrow is the same as the Value in column G:-1row above it.
        '====================================================================================
        
        'Trim leading/trailing spaces and convert to uppercase for CASE compare.
        sCallType = UCase(Trim(bCell.Value))
        
        Select Case sCallType
            Case "CALLS FORWARDED"
                '====================================================================================
                ' IMPORTANT: LOGIC CHECK FOR YOU TO VERIFY HERE!!!!
                ' Check your process logic. Your code has the same cells filled with the same info
                ' for both "Voice Calls Terminating" and "Voice Calls Originating"
                ' If its to be different, now would be a good time to change the values for the
                ' two different options. If both 'Terminating' and 'Originating' are suppose to
                ' do the same cell value updates then this can be siplified even more.
                '====================================================================================
                If (UCase(Trim(cCell)) = "VOICE CALLS TERMINATING") Then
                    cCell = bCell
                    iCell = hCell
                    lCell = kCell
                    bCell.EntireRow.Delete
                    
                ElseIf (UCase(Trim(cCell)) = "VOICE CALLS ORIGINATING") Then
                    cCell = bCell
                    iCell = hCell
                    lCell = kCell
                    bCell.EntireRow.Delete
                End If
                
            Case "VOICE CALLS ORIGINATING"
                '====================================================================================
                ' IMPORTANT LOGIC CHECK FOR YOU TO VERIFY HERE!!!!
                ' Notice this logic is the opposit check of the first CASE statement.
                ' It may be what you want to do, but only you can decide base on your process logic.
                '====================================================================================
                If UCase(Trim(cCell)) = "CALLS FORWARDED" Then
                    bCell = cCell
                    iCell = hCell
                    kCell = lCell
                    MyYesCell = jCell
                    cCell.EntireRow.Delete
                End If
        End Select
        
    Else
        '====================================================================================================
        ' We fall in here if ONE of the data compares of the 2 F column Values OR the 2 G column Values did not match.
        '====================================================================================================
        If UCase(Trim(dCell)) <> UCase(Trim(eCell)) Then
        'Do stuff here if (Column G same row as 'YES' row) and (column G -1 row offset of 'YES' row) are NOT equal.
        
        ElseIf UCase(Trim(fCell)) <> UCase(Trim(gCell)) Then
        'Else do stuff here if (Column H on same row as 'Yes') and (column H -1 offset of 'YES' row) are NOT equal.
        
        End If
    End If
End Sub
 
Last edited:
Upvote 0

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
good luck.
I did this without any of your data so if you need help with the logic you need to post a copy or a sample of your spreadsheet.
 
Upvote 0
Oh I should have mentioned that I didn't understand the use of the FoundAt Dim and where you have written 'just for testing'. Not sure what you mean by just string the addresses together. The error message on debug is 424 'object required' for that section. If I take this section out I get error 1004 unable to get FindNext property of the Range class. I have entered my if/then/elseif after the Do and ending with EndIf before the test section, which I think is what you meant?

Sorry missed this post.

The FoundAt is just a string value that collected the cell addresses of all the 'YES' values found in the spreadsheet. when the loop finishes it displays a MsgBox to show you the cell addesses it found 'YES' in.

Although the 1004 error pops just at the "Just Testing" stuff it is actually related to the deleting of rows that I talked about in the previous post. As i mentioned, looping through a spreadsheet that is having rows deleted while going through the loop. the error occured becuase the previous reference to the last found 'YES' cell is no longer valad because the previous code had the aCell set to NOTHING after that row was deleted.

Deleting a row makes the aCell reference change to Is Nothing. Too much info, i think....

Go with the new code and this should go away.
 
Upvote 0
Many thanks for your time spent helping me out brucef2112 and for your explanations as I think I understand what's going on a little better now. I will try your new code tomorrow at work.

For this particular data there would never be a "yes" in row 1 column D so it should be ok. I see your point about the range names corresponding with the columns, but maybe will leave this to tinker with until after I have got your code working.

Thanks again, I'll let you know how it went.
 
Upvote 0
Hi again brucef2112, I do feel that I've dived into the deep end before I can paddle! Nevertheless I have enjoyed working out how this code is working. It is surprisingly rewarding and makes me want to learn writing code a lot more. So thanks very much!

Your code worked very well, although after running the code and working on different datasets of the same type of data, I realised that there were more possible variables than I thought initially. This meant that the code was stopping in various places. When I re-ran the macro it would continue fine but keep stopping in certain unaccounted for cases of "yes". This meant that I needed to create another CASE to compare (I think). I've posted the full code below so see what you think. I also realised that in some cases it made more sense to replace the "no" in MyYesCell with "SKIP" so that I could check over these afterwards, as that would be best practice given the overall purpose of the project.

However, there are cases where dCell <> eCell or fCell <> gCell when the code stops running and I can't figure out why. I thought this section:
Code:
If UCase(Trim(dCell)) <> UCase(Trim(eCell)) Then
            MyYesCell = "SKIP"
            
        'Do stuff here if (Column G same row as 'YES' row) and (column G -1 row offset of 'YES' row) are NOT equal.
        
        ElseIf UCase(Trim(fCell)) <> UCase(Trim(gCell)) Then
            MyYesCell = "SKIP"

would apply in every case where these cells are not equal? I have noticed that it is always when there are 2 or more trigger words "yes" in a row or close together. It looks like the code has dealt with the first "yes" but then snagged on the result of this primary "yes" over the second "yes" straight afterwards. Maybe this is creating more variables resulting from the first "yes". But the result of the first "yes" looks on the surface to be usually a case of either dCell <> eCell or fCell <> gCell - so would expect the code to mark these as skip?

Here's the full code including most of your original comments (very helpful thank you btw) that I've tried to update. It seems to work but stops on some sections of the dataset as mentioned above:
Code:
Sub CDA_v16()

Dim oRange As Range, foundCell As Range
Dim FirstFoundCell As String, SearchString As String, FoundAt As String
Dim iCount As Integer
    
    SearchString = "YES"
    Set oRange = ActiveSheet.Columns("D:D")
    
    Set foundCell = oRange.Find(What:=SearchString, LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
    MatchCase:=False, SearchFormat:=False)
    
    If Not foundCell Is Nothing Then
        
        Do Until foundCell Is Nothing
            LastFoundCell = foundCell.Address
            '================================================================================
            'Do stuff here when the search returns a Cell with a match to your SearchString.
            '================================================================================
            'just for testing.
            FoundAt = FoundAt & foundCell.Address & ", " 'String the addresses together
            iCount = iCount + 1 'Let's keep count of how many we find.
            'End testing.
            
            'Actual Sub that will analyse your call log data.
            Call WorkTheCallData(foundCell)
            '================================================================================
            
            ' Lets see if there is more...
            Set foundCell = oRange.FindNext
            ' See if we looped back to the previous cell.
            ' If we did then we are finished searching
            ' However the DoSomeWork sub actually deletes the found row if the logic is correct
            ' so the original find might have been deleted in its process. So just check for nothing on
            ' subsequent .Finds
            If Not foundCell Is Nothing Then If foundCell.Address = LastFoundCell Then Set foundCell = Nothing
        Loop
        
        '==========================================================================
        ' We get here after we have found all matches to our SearchString
        '==========================================================================
        FoundAt = Trim(FoundAt)
        FoundAt = Left(FoundAt, Len(FoundAt) - 1)
        MsgBox "Number of times we found it: " & iCount & vbCrLf & FoundAt, vbOKOnly, "Finished!"
        
    Else
        '==========================================================================
        'NEVER found the SearchString.
        'If you need to do something when not found, do it here. If not,leave this empty.
        '==========================================================================
        MsgBox "Got Nothing...", vbOKOnly, "Finished..."
        
        '==========================================================================
    End If
End Sub


Sub WorkTheCallData(MyYesCell As Range)
'=================================================
' MyYesCell is the D column cell with 'YES' in it.
'=================================================
Dim bCell As Range, cCell As Range, dCell As Range, eCell As Range, fCell As Range
Dim gCell As Range, hCell As Range, iCell As Range, jCell As Range, kCell As Range, lCell As Range
Dim sCallType As String, txtCallType As String
    ' =====================================================================================
    ' I know nothing about the data in most of your cells. So DOUBLE CHECK your logic
    ' on your Phone Call Log processes to be sure its shifting data as you need.
    ' Even though I don't have all the specifics, your logic may be flawed for your intent.
    ' Just check it to make sure it is doing what you want based on your process rules.
    ' =====================================================================================
    ' Would be nice if the a,b,c ranges acutally related to their respective column letters and offset.
    ' but lets just go with what you have for now.
    ' =====================================================================================
    
    Set bCell = MyYesCell.Offset(1, 1) ' bCell is column E on row with 'YES'.
    
    ' =====================================================================================
    ' Note that You had the cCell below, being set to a negative row offset.
    ' This will fail if 'Yes' is ever found in row 1 of column D. ie row1 -1 equals row0
    ' If D1 will NEVER, EVER possibly have the value of 'YES' then this will be fine.
    ' Otherwise some code should be added to check if the 'YES' is found on row1.
    ' =====================================================================================
    Set cCell = bCell.Offset(-1, 0) ' cCell is column E cell with a -1 row from 'Yes'
    Set dCell = bCell.Offset(0, 1)  ' dCell is column F cell on row with 'YES'.
    Set eCell = cCell.Offset(0, 1)  ' eCell is column F cell with a -1 row from 'Yes'
    Set fCell = bCell.Offset(0, 2)  ' fCell is column G cell on row with 'YES'.
    Set gCell = cCell.Offset(0, 2)  ' gCell is column G cell with a -1 row from 'Yes'
    Set hCell = fCell.Offset(0, 3)  ' hCell is column J cell on row with 'YES'.
    Set iCell = gCell.Offset(0, 3)  ' iCell is column J cell with a -1 row from 'Yes'
    
    ' =====================================================================================
    ' Note that You had the jCell below, being set to a negative row offset.
    ' SAME ISSUE AS cCell LOGIC ABOVE.
    ' =====================================================================================
    Set kCell = hCell.Offset(0, 1)  ' kCell is column K cell on row with 'YES'.
    Set lCell = iCell.Offset(0, 1)  ' lCell is column K cell with a -1 row from 'Yes'
    
    If (dCell = eCell) And (fCell = gCell) Then
        '====================================================================================
        ' We fall in here IF:
        ' The Value in column F:on foundrow is the same as the Value in column F:-1row above it.
        ' AND
        ' The Value in column G:on foundrow is the same as the Value in column G:-1row above it.
        '====================================================================================
        
        'Trim leading/trailing spaces and convert to uppercase for CASE compare.
        sCallType = UCase(Trim(bCell.Value))
        txtCallType = UCase(Trim(cCell.Value))
        
        Select Case sCallType
            Case "CALLS FORWARDED"
                '====================================================================================
                ' IMPORTANT: LOGIC CHECK FOR YOU TO VERIFY HERE!!!!
                ' Check your process logic. Your code has the same cells filled with the same info
                ' for both "Voice Calls Terminating" and "Voice Calls Originating"
                ' If its to be different, now would be a good time to change the values for the
                ' two different options. If both 'Terminating' and 'Originating' are suppose to
                ' do the same cell value updates then this can be siplified even more.
                '====================================================================================
                If (UCase(Trim(cCell)) = "VOICE CALLS TERMINATING") Then
                    cCell = bCell
                    iCell = hCell
                    lCell = kCell
                    MyYesCell = "no"
                    bCell.EntireRow.Delete
                    
                ElseIf (UCase(Trim(cCell)) = "VOICE CALLS ORIGINATING") Then
                    cCell = bCell
                    iCell = hCell
                    lCell = kCell
                    MyYesCell = "no"
                    bCell.EntireRow.Delete
                
                ElseIf (UCase(Trim(cCell)) = "VOIP VOICE CALLS ORIGINATING") Then
                    cCell = bCell
                    iCell = hCell
                    lCell = kCell
                    MyYesCell = "no"
                    bCell.EntireRow.Delete
                    
                ElseIf (UCase(Trim(cCell)) = "SMS CALLS TERMINATING") Then
                    MyYesCell = "SKIP"
                End If
                
            Case "VOICE CALLS ORIGINATING"
                '====================================================================================
                ' IMPORTANT LOGIC CHECK FOR YOU TO VERIFY HERE!!!!
                ' Notice this logic is the opposit check of the first CASE statement.
                ' It may be what you want to do, but only you can decide base on your process logic.
                '====================================================================================
                If UCase(Trim(cCell)) = "CALLS FORWARDED" Then
                    bCell = cCell
                    hCell = iCell
                    kCell = lCell
                    cCell.EntireRow.Delete
                End If
                
            Case "VOICE CALLS TERMINATING"
            '====================================================================================
            ' IMPORTANT LOGIC CHECK FOR YOU TO VERIFY HERE!!!!
            ' Notice this logic is the opposit check of the first CASE statement.
            ' It may be what you want to do, but only you can decide base on your process logic.
            '====================================================================================
            If UCase(Trim(cCell)) = "VOICE CALLS TERMINATING" And hCell = iCell Then
                    cCell.EntireRow.Delete
                End If
                
        End Select
        
        Select Case txtCallType
            Case "SMS CALLS ORIGINATING"
                
                If (UCase(Trim(cCell)) = "SMS CALLS ORIGINATING") Then
                    MyYesCell = "SKIP"
                End If
                 
            Case "SMS CALLS TERMINATING"
                
                If (UCase(Trim(cCell)) = "SMS CALLS TERMINATING") Then
                    MyYesCell = "SKIP"
                End If
                
            Case "VOIP SMS CALLS TERMINATING"
            
                If (UCase(Trim(cCell)) = "VOIP SMS CALLS TERMINATING") Then
                    MyYesCell = "SKIP"
                End If
                
            Case "VOIP VOICE CALLS TERMINATING"
            
                If (UCase(Trim(cCell)) = "VOIP VOICE CALLS TERMINATING") Then
                    MyYesCell = "SKIP"
                End If
        
        
        End Select
        
    Else
        '====================================================================================================
        ' We fall in here if ONE of the data compares of the 2 F column Values OR the 2 G column Values did not match.
        '====================================================================================================
        
        ' Add command for erase "yes" when no action to be taken*********
        
        If UCase(Trim(dCell)) <> UCase(Trim(eCell)) Then
            MyYesCell = "SKIP"
            
        'Do stuff here if (Column G same row as 'YES' row) and (column G -1 row offset of 'YES' row) are NOT equal.
        
        ElseIf UCase(Trim(fCell)) <> UCase(Trim(gCell)) Then
            MyYesCell = "SKIP"
            
        ElseIf UCase(Trim(dCell)) <> UCase(Trim(eCell)) And bCell = cCell Then
            MyYesCell = "SKIP"
            
        ElseIf UCase(Trim(fCell)) <> UCase(Trim(gCell)) And bCell = cCell Then
            MyYesCell = "SKIP"
                
        'Else do stuff here if (Column H on same row as 'Yes') and (column H -1 offset of 'YES' row) are NOT equal.
        
        End If
    End If
End Sub

It does seem to be getting quite complex or is that just me starting out in programming? Any thoughts please brucef2112?

PS
I have ready a sanitised section of the data if you think that would help (though not sure if I can attach a excel file to the post?). Unfortunately I've left it at work so not available until Monday.:rolleyes:
 
Upvote 0
Let me take a look at it. Life got in the way of coding fun. So I'll get back to ya in a bit when I have a moment to check it through....
 
Upvote 0
Spidaman said:
...However, there are cases where dCell <> eCell or fCell <> gCell when the code stops running and I can't figure out why. I thought this section:[somecodesnipet]...would apply in every case where these cells are not equal?
Based on your original post, the logic was that BOTH had to be EQUAL to themselves (d=e) AND (f=g). If EITHER one of them was not equal then logic would move to the ELSE. Keep in mind that at this point in the code, it could be EITHER one, OR NEITHER one is true. At this point it is up to you on how the code should proceess based on this point.


In the 'ELSE' section of the "IF" where it evlauates if (2cells in F: Column don't match) AND (2 cells in G: Column don't match) you have the "IF...ElseIf...End IF" doing Four comparisons and it writes "SKIP" to the first one it finds and then call it quits.
So you are only checking for the FIRST one that is not a match.


If instead, your intent at this point in the logic is to evaluate all four individually, then you have to change the "IF...ElseIf...End IF's" to four separate "IF...Then"'s. This will have each column evaluated regardless of the tests of the other 3 columns.
Like this:
Code:
'====================================================================================================
' We fall in here if ONE of the data compares of the 2 F column Values OR the 2 G column Values did not match.
'====================================================================================================
        ' Add command for erase "yes" when no action to be taken*********
    'This will now evaluate all 4 column compares individually and take the 'SKIP' action if needed.
        If UCase(Trim(dCell)) <> UCase(Trim(eCell)) Then MyYesCell = "SKIP" 
        If UCase(Trim(fCell)) <> UCase(Trim(gCell)) Then MyYesCell = "SKIP"       
        If UCase(Trim(dCell)) <> UCase(Trim(eCell)) And bCell = cCell Then MyYesCell = "SKIP"            
        If UCase(Trim(fCell)) <> UCase(Trim(gCell)) And bCell = cCell Then MyYesCell = "SKIP"
So depending on the data in the cells, "SKIP" could be written to NONE, ONE or more of the MyYesCells value.Let me know if this is the logic you're missing.


I also notice you update the first CASE statement by adding the 'VOIP VOICE CALLS ORIGINATING'.
Code:
Select Case sCallType"
   CASE "CALLS FORWARDED"
             IF.....
             ELSEIF....
             ELSEIF....
             ELSEIF....
             ELSE....
             END IF
.............
Note that the first 3 "IF...ELSE..." do the same exact column shifts if any one of them is TRUE. (this is what you wanted it to do, right?)
Reducing redundant code is generally a good thing. The most important point is, a minor typo within the redundant code will make you loose sleep trying to find the code error.
Shifting cells (c to equal b, i to equal h, i to equal k) written once is do-able, but 3 or more is a strong chance for a typo or logic error.


For ease of readability (we still have these crazy alphabet soup cell reference) and of the program logic, it would be better to replace the "IF...ElseIf..End if" with a CASE statement.


This CASE statement is the same as your 4 level 'IF..ELSIF...EndIF' and is easier to follow and less prone to errors because it removes the redundant code. As you can see, its readabiliy goes up significantly to understand that we are looking for a match on any three items listed and if found, will shift the cells.
Code:
        Select Case UCase(Trim(cCell))
                    ' We can have multiple matches run the same code. It saves 10's of keystrokes and 10's of headaches later. :)
                    Case "VOICE CALLS TERMINATING", "VOICE CALLS ORIGINATING", "VOIP VOICE CALLS ORIGINATING"
                        cCell = bCell
                        iCell = hCell
                        lCell = kCell
                        MyYesCell = "no"
                        bCell.EntireRow.Delete
                        
                    Case "SMS CALLS TERMINATING"
                        MyYesCell = "SKIP"
                End Select

Funny how computers will do exactly what you tell them to do....
Let me know how it goes.
 
Last edited:
Upvote 0
"If instead, your intent at this point in the logic is to evaluate all four individually, then you have to change the "IF...ElseIf...End IF's" to four separate "IF...Then"'s. This will have each column evaluated regardless of the tests of the other 3 columns."

Yes that may well be the logic I'm missing. The intent is to evaluate the four possibilities individually. This must be why the code is stopping. I will try separating the "If/ElseIf...End IF's" statement to four separate "IF...Then's" as you suggest.

I also take on board the direction around redundant code. Using another CASE certainly makes more sense.

Unfortunately I'm away with the kids now until early September so won't get to try this until I get back, but look forward to making the changes and seeing the code work. If you don't mind I'll get back to you then as no access to the data until I'm back at work.

Ultimately what I'd like to achieve is actually code that is not based on the current "yes/no" column. (Sorry to only say this now but never thought I'd get this far tbh). The MyYesCell column is based on a simple excel equation prior to running the code that indicates whether the time difference between the calls is 2 seconds or less. A MyYesCell = 2 seconds or less between the call/SMS on that row and the next row. At the moment I am running a more simple code to establish this first, populating 2 extra columns inserted into the original data. Ideally I would have one code that first identifies whether the calls are 2 seconds or less apart, and if so, then carries out the actions that we have been working on already. This was too much for me to try and incorporate to begin with. I still can't see how to work this myself but will have another go at combining the two codes and adjusting the one you have helped me with based on the same logic.
 
Upvote 0
Hi again brucef2112,

Sorry I've taken ages to give you feedback on this one. The procedure finally seems to work well having made some changes. I managed to remove one of the case selects and get all the variations working off the one case select only which seemed to do the trick. I also took your advice and changed all the cell references to logical ones which were easier to follow. I had problems trying to use the CASE statement that you advised so still haven't incorporated it. I did try the separate IF...THENs near the bottom of the procedure but after a lot of debugging I eventually went back to ESLE...IFs. Also I decided that using the MyYesCell column is probably still the best way of achieving my goal as the resulting column allows me to see those cases labelled 'SKIP', which are best to look at individually afterwards due to their potential to be anomalies in the dataset. Here's the code as it stands now:

Code:
Sub WorkTheCallData(MyYesCell As Range)
 
Dim atopCell As Range, abotCell As Range, btopCell As Range, bbotCell As Range
Dim ebotCell As Range, etopCell As Range, fbotCell As Range, ftopCell As Range, gtopCell As Range, gbotCell As Range
Dim htopCell As Range, hbotCell As Range, ibotCell As Range, itopCell As Range, jbotCell As Range, jtopCell As Range
Dim kbotCell As Range, ktopCell As Range, lbotCell As Range, ltopCell As Range, mbotCell As Range, mtopCell As Range
Dim nbotCell As Range, ntopCell As Range, obotCell As Range, otopCell As Range, pbotCell As Range, ptopCell As Range
Dim qbotCell As Range, qtopCell As Range, rbotCell As Range, rtopCell As Range, sbotCell As Range, stopCell As Range
Dim tbotCell As Range, ttopCell As Range, ubotCell As Range, utopCell As Range, vbotCell As Range, vtopCell As Range
Dim wbotCell As Range, wtopCell As Range, xbotCell As Range, xtopCell As Range
Dim txtCallType As String
       
    Set ebotCell = MyYesCell.Offset(1, 1)
    Set etopCell = MyYesCell.Offset(0, 1)
    Set fbotCell = ebotCell.Offset(0, 1)
    Set ftopCell = etopCell.Offset(0, 1)
    Set gbotCell = fbotCell.Offset(0, 1)
    Set gtopCell = ftopCell.Offset(0, 1)
    Set hbotCell = gbotCell.Offset(0, 1)
    Set htopCell = gtopCell.Offset(0, 1)
    Set ibotCell = hbotCell.Offset(0, 1)
    Set itopCell = htopCell.Offset(0, 1)
    Set jbotCell = ibotCell.Offset(0, 1)
    Set jtopCell = itopCell.Offset(0, 1)
    Set kbotCell = jbotCell.Offset(0, 1)
    Set ktopCell = jtopCell.Offset(0, 1)
    Set atopCell = etopCell.Offset(0, -4)
    Set abotCell = ebotCell.Offset(0, -4)
    Set btopCell = atopCell.Offset(0, 1)
    Set bbotCell = abotCell.Offset(0, 1)
    Set lbotCell = kbotCell.Offset(0, 1)
    Set ltopCell = ktopCell.Offset(0, 1)
    Set mbotCell = lbotCell.Offset(0, 1)
    Set mtopCell = ltopCell.Offset(0, 1)
    Set nbotCell = mbotCell.Offset(0, 1)
    Set ntopCell = mtopCell.Offset(0, 1)
    Set obotCell = nbotCell.Offset(0, 1)
    Set otopCell = ntopCell.Offset(0, 1)
    Set pbotCell = obotCell.Offset(0, 1)
    Set ptopCell = otopCell.Offset(0, 1)
    Set qbotCell = pbotCell.Offset(0, 1)
    Set qtopCell = ptopCell.Offset(0, 1)
    Set rbotCell = qbotCell.Offset(0, 1)
    Set rtopCell = qtopCell.Offset(0, 1)
    Set sbotCell = rbotCell.Offset(0, 1)
    Set stopCell = rtopCell.Offset(0, 1)
    Set tbotCell = sbotCell.Offset(0, 1)
    Set ttopCell = stopCell.Offset(0, 1)
    Set ubotCell = tbotCell.Offset(0, 1)
    Set utopCell = ttopCell.Offset(0, 1)
    Set vbotCell = ubotCell.Offset(0, 1)
    Set vtopCell = utopCell.Offset(0, 1)
    Set wbotCell = vbotCell.Offset(0, 1)
    Set wtopCell = vtopCell.Offset(0, 1)
    Set xbotCell = wbotCell.Offset(0, 1)
    Set xtopCell = wtopCell.Offset(0, 1)
   
   
    If (ftopCell = fbotCell) And (gtopCell = gbotCell) Then
 
              
        ' Trim leading/trailing spaces and convert to uppercase for CASE compare.
       
        txtCallType = UCase(Trim(etopCell.Value))
       
        Select Case txtCallType
           
            Case "CALLS FORWARDED"
 
                If (UCase(Trim(ebotCell)) = "VOICE CALLS ORIGINATING") Then
                     atopCell = abotCell
                     btopCell = bbotCell
                     htopCell = hbotCell
                     itopCell = ibotCell
                     ltopCell = lbotCell
                     mtopCell = mbotCell
                     ntopCell = nbotCell
                     otopCell = obotCell
                     ptopCell = pbotCell
                     qtopCell = qbotCell
                     rtopCell = rbotCell
                     stopCell = sbotCell
                     ttopCell = tbotCell
                     utopCell = ubotCell
                     vtopCell = vbotCell
                     wtopCell = wbotCell
                     xtopCell = xbotCell
                     MyYesCell = "no"
                     ebotCell.EntireRow.Delete
                    
                ElseIf (UCase(Trim(ebotCell)) = "VOICE CALLS TERMINATING") Then
                     atopCell = abotCell
                     btopCell = bbotCell
                     htopCell = hbotCell
                     itopCell = ibotCell
                     ltopCell = lbotCell
                     mtopCell = mbotCell
                     ntopCell = nbotCell
                     otopCell = obotCell
                     ptopCell = pbotCell
                     qtopCell = qbotCell
                     rtopCell = rbotCell
                     stopCell = sbotCell
                     ttopCell = tbotCell
                     utopCell = ubotCell
                     vtopCell = vbotCell
                     wtopCell = wbotCell
                     xtopCell = xbotCell
                     MyYesCell = "no"
                     ebotCell.EntireRow.Delete
 
                ElseIf (UCase(Trim(ebotCell)) = "SMS CALLS TERMINATING") Then
                     MyYesCell = "no"
                   
                ElseIf (UCase(Trim(ebotCell)) = "CALLS FORWARDED" And lbotCell = ltopCell) Then
                     MyYesCell = "no"
                     ebotCell.EntireRow.Delete
                    
'                ElseIf (UCase(Trim(ebotCell)) = "CALLS FORWARDED" And lbotCell = ltopCell) Then
'                     etopCell.EntireRow.Delete
                     
                End If
               
            Case "VOICE CALLS ORIGINATING"
           
                If (UCase(Trim(ebotCell)) = "CALLS FORWARDED") Then
                    etopCell = ebotCell
                    jtopCell = jbotCell
                    ktopCell = kbotCell
                    MyYesCell = "no"
                    ebotCell.EntireRow.Delete
               
                ElseIf (UCase(Trim(ebotCell)) = "VOICE CALLS ORIGINATING" And lbotCell = ltopCell) Then
                    MyYesCell = "no"
                    ebotCell.EntireRow.Delete
                   
                End If
                   
            Case "VOICE CALLS TERMINATING"
           
                If (UCase(Trim(ebotCell)) = "CALLS FORWARDED") Then
                    etopCell = ebotCell
                    jtopCell = jbotCell
                    ktopCell = kbotCell
                    MyYesCell = "no"
                    ebotCell.EntireRow.Delete
                   
                ElseIf (UCase(Trim(ebotCell)) = "VOICE CALLS TERMINATING" And lbotCell = ltopCell) Then
                    MyYesCell = "no"
                    ebotCell.EntireRow.Delete
                   
                ElseIf (UCase(Trim(ebotCell)) = "VOIP VOICE CALLS TERMINATING") Then
                    etopCell = "VOIP Voice Calls Terminating"
                    MyYesCell = "no"
                    ebotCell.EntireRow.Delete
                   
                End If
           
            Case "VOIP VOICE CALLS ORIGINATING"
           
                If (UCase(Trim(ebotCell)) = "CALLS FORWARDED") Then
                    jtopCell = jbotCell
                    ktopCell = kbotCell
                    ltopCell = lbotCell
                    etopCell = "Calls Forwarded (VOIP Originating Call)"
                    MyYesCell = "no"
                    ebotCell.EntireRow.Delete
                End If
           
            Case "VOIP VOICE CALLS TERMINATING"
           
                If (UCase(Trim(ebotCell)) = "VOIP VOICE CALLS TERMINATING") Then
                    ' Prev an error here in 'If' clause with cCell (now etopCell) used in arguement
                    MyYesCell = "SKIP"
                   
                ElseIf (UCase(Trim(ebotCell)) = "VOICE CALLS TERMINATING") Then
                     atopCell = abotCell
                     btopCell = bbotCell
                     htopCell = hbotCell
                     itopCell = ibotCell
                     jtopCell = jbotCell
                     ltopCell = lbotCell
                     mtopCell = mbotCell
                     ntopCell = nbotCell
                     otopCell = obotCell
                     ptopCell = pbotCell
                     qtopCell = qbotCell
                     rtopCell = rbotCell
                     stopCell = sbotCell
                     ttopCell = tbotCell
                     utopCell = ubotCell
                     vtopCell = vbotCell
                     wtopCell = wbotCell
                     xtopCell = xbotCell
                     MyYesCell = "no"
                     ebotCell.EntireRow.Delete
               
                End If
           
            Case "VOIP SMS CALLS TERMINATING"
           
                If (UCase(Trim(ebotCell)) = "VOIP SMS CALLS TERMINATING") Then
                    ' Prev an error here in 'If' clause with cCell (now etopCell) used in arguement
                    MyYesCell = "SKIP"
                End If
           
            Case "SMS CALLS ORIGINATING"
                
                If (UCase(Trim(ebotCell)) = "SMS CALLS ORIGINATING" And lbotCell = ltopCell) Then
                    ' Prev an error here in 'If' clause with cCell (now etopCell) used in arguement
                    MyYesCell = "no"
                    ebotCell.EntireRow.Delete
               
                ElseIf (UCase(Trim(ebotCell)) = "SMS CALLS ORIGINATING") Then
                    ' Prev an error here in 'If' clause with cCell (now etopCell) used in argument
                    MyYesCell = "no"
                End If
                
            Case "SMS CALLS TERMINATING"
               
                If (UCase(Trim(ebotCell)) = "SMS CALLS TERMINATING" And lbotCell = ltopCell) Then
                    ' Prev an error here in 'If' clause with cCell (now etopCell) used in argument
                    MyYesCell = "no"
                    ebotCell.EntireRow.Delete
 
                ElseIf (UCase(Trim(ebotCell)) = "SMS CALLS TERMINATING") Then
                    ' Prev an error here in 'If' clause with cCell (now etopCell) used in argument
                    MyYesCell = "no"
                   
                ElseIf (UCase(Trim(ebotCell)) = "CALLS FORWARDED") Then
                    MyYesCell = "no"
                   
                ElseIf (UCase(Trim(ebotCell)) = "VOICE CALLS TERMINATING") Then
                    MyYesCell = "no"
               
                End If
               
        End Select
       
    ElseIf UCase(Trim(gtopCell)) <> UCase(Trim(gbotCell)) And (UCase(Trim(ebotCell)) = "VOICEMAIL CALLS") And _
        (UCase(Trim(etopCell)) = "VOICE CALLS ORIGINATING") Then
            etopCell = "Call To Voicemail"
            jtopCell = jbotCell
            MyYesCell = "no"
            ebotCell.EntireRow.Delete
           
    ElseIf UCase(Trim(gtopCell)) <> UCase(Trim(gbotCell)) And (UCase(Trim(etopCell)) = "VOICEMAIL CALLS") And _
        (UCase(Trim(ebotCell)) = "VOICE CALLS ORIGINATING") Then
            atopCell = abotCell
            btopCell = bbotCell
            ftopCell = fbotCell
            gtopCell = gbotCell
            htopCell = hbotCell
            itopCell = ibotCell
            ltopCell = lbotCell
            mtopCell = mbotCell
            ntopCell = nbotCell
            otopCell = obotCell
            ptopCell = pbotCell
            qtopCell = qbotCell
            rtopCell = rbotCell
            stopCell = sbotCell
            ttopCell = tbotCell
            utopCell = ubotCell
            vtopCell = vbotCell
            wtopCell = wbotCell
            xtopCell = xbotCell
            MyYesCell = "no"
            ebotCell.EntireRow.Delete
           
    ElseIf UCase(Trim(ftopCell)) <> UCase(Trim(fbotCell)) And (UCase(Trim(ebotCell)) = "VOIP SMS CALLS TERMINATING") And _
        (UCase(Trim(etopCell)) = "SMS CALLS TERMINATING") Then
            MyYesCell = "SKIP"
           
    ElseIf UCase(Trim(ftopCell)) <> UCase(Trim(fbotCell)) And (UCase(Trim(ebotCell)) = "SMS CALLS TERMINATING") And _
        (UCase(Trim(etopCell)) = "VOIP SMS CALLS TERMINATING") Then
            MyYesCell = "SKIP"
   
    ElseIf UCase(Trim(gtopCell)) <> UCase(Trim(gbotCell)) Then MyYesCell = "no"
           
    ElseIf UCase(Trim(ftopCell)) <> UCase(Trim(fbotCell)) Then MyYesCell = "no"
   
    End If
   
End Sub

I found it worked better when I was always deleting the 'ebotCell' row rather than the 'etopCell' row which contained 'MyYesCell'. So I adjusted the procedure to always remove the second row, even though this meant having to copy a lot more data from cell to cell in some cases. Any thoughts for improvements or to speed up the macro?

There's no way I could have got this working successfully without your help so thanks very much! Much appreciated!

I now have another three similar procedures to write for different types of datasets so am going to try and adjust this code as best I can. For one of these procedures I need the code to request the user to enter a target phone number (maybe into a particular cell [probably more simple] or into a pop-up box?) which will then be used in the procedure as a basis for the code. Any idea how I might do this???

No worries if you're fed up with me already! I understand completely ~
 
Upvote 0

Forum statistics

Threads
1,226,486
Messages
6,191,302
Members
453,653
Latest member
mvillasana

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top