Struggling to create a loop in VBA

[spidaman]

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 . 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​

 

[Michael M]

Might be a lot easier if you told us exactly what you are trying to do.
Also, in future can you please use code tags, see my sig block
You could also use the HTML Maker in my tag to post a SMALL sample of what you are trying to achieve

 

[spidaman]

Might be a lot easier if you told us exactly what you are trying to do.
Also, in future can you please use code tags, see my sig block
You could also use the HTML Maker in my tag to post a SMALL sample of what you are trying to achieve

Hi Michael
Thanks for your reply.
Apologies for the format; this is because the code has been copied from vba to word then pasted to the forum. I tried editing the spacing/indents etc but was unfamiliar with the formatting tools. I will also use the code tags in future.

I'm trying to find each "yes" in the D column (column of no and yes only) and in each case apply one of 4 possibilities depending on what text is found in the corresponding columns. In each case the code should only apply to 2 rows of data - the row with the "yes" cell and the row directly above. An action should only be applied if numbers in dCell = eCell And fCell = gCell in all cases. In the first 2 if/then possibilities I need the text from the adjacent cell to the right of the "yes" copied into the row above same column, as well as hCell copied into iCell and kCell copied into the lCell. Then the entire row containing bCell needs to be deleted. In the third if/then I need the text from cCell copied into bCell (reverse from first 2 if/thens), iCell copied to hCell, lCell copied to kCell (ie. reverse of first 2 if/thens again), but also jCell copied to aCell. Then the entire row containing cCell needs to be deleted. For the final 2 ElseIf commands I've tried to make sure that if dCell does not = eCell or fCell does not = gCell that no action is taken at all and code moves on to the next "yes". That would complete all the possibilities for the occurrence of "yes" in D column. Ideally I would like to create a loop so that the if/then cycle then continues throughout the entire active sheet up to and including the final row.

Sorry, it's a rather long explanation, but I hope that helps clarify what I'm trying to achieve.
Thanks again for your help.
Steve

 

[My Aswer Is This]

Wow. That's a lot of If's.
I'll just watch this posting.

 

[Michael M]

OK, lets ignore all these

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)

Now lets assume "yes" is found in cell D3.
Explain by actual cell reference what then needs to happen based on the yes in D3 !!

 

[brucef2112]

I'll try and see what your cell references are doing later.

But here is what you need to loop through all your 'YES' found.
Put the code you want to run when 'YES" is found in the "Do stuff here when your aCell matches your SearchString" area.

Sub CDA_v2()Dim oRange As Range
Dim FirstFoundCell As Range
Dim aCell As Range
Dim SearchString As String
Dim bIsFinished As Boolean
Dim FoundAt As String
Dim iCount As Integer
Set oRange = ActiveSheet.Columns("D:D")
SearchString = "YES"


Set aCell = oRange.Find(What:=SearchString, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)


If Not aCell Is Nothing Then
    Set FirstFoundCell = aCell
    Do
        '=======================================================
        'Do stuff here when your aCell matches your SearchString.
        '=======================================================
        FoundAt = FoundAt & aCell.Address & ", " 'just for testing just string the addresses together
        iCount = iCount + 1 'just for testing lets keep count of how many we find.
        
        
        '=======================================================
        
        ' Lets see if there is more...
        Set aCell = oRange.FindNext(after:=aCell)
        
        ' See if we looped back to the first cell.
        ' If we did then we are finished searching
        bIsFinished = (aCell.Address = FirstFoundCell.Address)
        
    Loop Until bIsFinished
    
    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

For your future code samples submission, to paste code as shown above;
highlight your code in VBA and copy.
When writing your message and you want to insert a chunk of code, click on the button that has "#". It will incert the 'CODE' tags. You then place your cursor inbetween then paste. When you preview or submit you'll see your code formated just as in your VBA code you originally type.

 

[brucef2112]

Well not being able to edit your post after 10 minutes seems a bit too short.
Tried to fix a typo in the code. but found out after 10 minutes you can't. Includes if you started editing before 10min but your edit time was after it, you still lose.

Anyway,
Notice the Sub declaration at the top? (very first line) It needs a line feed just before the Dim oRange as Range.

First line is:

Sub CDA_v2()Dim oRange As Range

needs to be

Sub CDA_v2()
Dim oRange As Range

all else is good.

 

[spidaman]

OK, lets ignore all these

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)

Now lets assume "yes" is found in cell D3.
Explain by actual cell reference what then needs to happen based on the yes in D3 !!

Ok

If "yes" is found in D3 and F2 = F3 as well as G2 = G3, and if E3 = "Calls Forwarded" and E2 = "Voice Calls Terminating" or "Voice Calls Originating": then copy E3 to E2, copy J3 to J2 and copy K3 to K2. Then delete the row containing E3.
Else if F2 = F3 as well as G2 = G3, and if E3 = "Calls Originating" and E2 = "Calls Forwarded": then copy E2 to E3, J2 to J3 and copy K2 to K3. Then delete the row containing E2.
Else if F2 <> F3 or G2 <> G3 do nothing and move on to the next "yes".
This needs to loop throughout the active sheet until final row.

Does that make any sense?
Thanks in advance

 

[spidaman]

I'll try and see what your cell references are doing later.

But here is what you need to loop through all your 'YES' found.
Put the code you want to run when 'YES" is found in the "Do stuff here when your aCell matches your SearchString" area.

Sub CDA_v2()Dim oRange As Range
Dim FirstFoundCell As Range
Dim aCell As Range
Dim SearchString As String
Dim bIsFinished As Boolean
Dim FoundAt As String
Dim iCount As Integer
Set oRange = ActiveSheet.Columns("D:D")
SearchString = "YES"


Set aCell = oRange.Find(What:=SearchString, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)


If Not aCell Is Nothing Then
    Set FirstFoundCell = aCell
    Do
        '=======================================================
        'Do stuff here when your aCell matches your SearchString.
        '=======================================================
        FoundAt = FoundAt & aCell.Address & ", " 'just for testing just string the addresses together
        iCount = iCount + 1 'just for testing lets keep count of how many we find.
        
        
        '=======================================================
        
        ' Lets see if there is more...
        Set aCell = oRange.FindNext(after:=aCell)
        
        ' See if we looped back to the first cell.
        ' If we did then we are finished searching
        bIsFinished = (aCell.Address = FirstFoundCell.Address)
        
    Loop Until bIsFinished
    
    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

For your future code samples submission, to paste code as shown above;
highlight your code in VBA and copy.
When writing your message and you want to insert a chunk of code, click on the button that has "#". It will incert the 'CODE' tags. You then place your cursor inbetween then paste. When you preview or submit you'll see your code formated just as in your VBA code you originally type.

Thanks for your help, this does look like it should achieve what I'm trying to do. However due to my lack of experience with vba I'm still getting error messages. Unfortunately I can't post the code for my most recent attempt (based on your direction) as I'm only posting on my cell phone until I get home. I will post the code and new error message this evening.

 

[spidaman]

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?