Do without Loop

gmazza76

Well-known Member
Joined
Mar 19, 2011
Messages
764
Office Version
  1. 365
Platform
  1. Windows
Good Afternoon,

I am having an issue creating the code below.
I have only ever used "Else" with 2 sets of criteria and need to complete this with 3 outcomes instead of 3 and I am missing something. It looks like I have an "If" possibly missing, but am unsure of where to enter it in the code, or I could be barking up the wrong tree.

Thanks in advance.
Gavin

Code:
Sub Open_Search()


Dim AgentName, CriteriaScore, CriteriaName As Variant
Dim Startdate, RaisedDate, Stopdate, Stopdate1 As Variant
Dim Ptype, Status, RaisedD, DDAte, PDescription, RefNo As Variant
Dim FoundMe As Boolean
Dim x, y As Integer
Dim LS, J As Long


Startdate = Worksheets("Advocate Data").Range("J8").Value
Stopdate = Worksheets("Advocate Data").Range("J4").Value
Stopdate1 = Worksheets("Advocate Data").Range("J12").Value
CriteriaName = Worksheets("Advocate Data").Range("K5").Value
    
    Application.ScreenUpdating = False
    Sheets("Import Open").Select


    FoundMe = False
    
    If Range("E22") = "" Then
            Application.ScreenUpdating = True
            MsgBox "Please Select Work Load to check", vbOKOnly, "Missing Workload"
        Exit Sub
    Else
            CriteriaScore = Range("E22")
    End If

'*******
    x = 0
    y = 0
      
      Do
        x = x + 1
        Sheets("Import Open").Select
        Range("E1").Select
        AgentName = ActiveCell.Offset(x, 0).Value 'E
        Ptype = ActiveCell.Offset(x, -1).Value 'D
        Status = ActiveCell.Offset(x, -2).Value 'C
        RaisedD = ActiveCell.Offset(x, -4).Value 'A
        DDAte = ActiveCell.Offset(x, -3).Value 'B
        PDescription = ActiveCell.Offset(x, 1).Value 'F
        RefNo = ActiveCell.Offset(x, 2).Value 'G
        
        If CriteriaScore = "Today" Then
            If AgentName = CriteriaName And RaisedD = Startdate Then
                
                y = y + 1
                Sheets("Open").Select
                Range("C24").Select
                ActiveCell.Offset(y, 0).Value = RaisedD
                Range("C24").Select
                ActiveCell.Offset(y, 1).Value = DDAte
                Range("C24").Select
                ActiveCell.Offset(y, 3).Value = RefNo
                Range("C24").Select
                ActiveCell.Offset(x, 4).Select = Ptype
                Range("C24").Select
                ActiveCell.Offset(x, 6).Select = PDescription
                FoundMe = True
            End If
            ActiveCell.Offset(x, 0).Select
    Else
        If CriteriaScore = "Over Due" Then
            If AgentName = CriteriaName And RaisedD < Startdate Then
           Do
                y = y + 1
                Sheets("Open").Select
                Range("C24").Select
                ActiveCell.Offset(y, 0).Value = RaisedD
                Range("C24").Select
                ActiveCell.Offset(y, 1).Value = DDAte
                Range("C24").Select
                ActiveCell.Offset(y, 3).Value = RefNo
                Range("C24").Select
                ActiveCell.Offset(x, 4).Select = Ptype
                Range("C24").Select
                ActiveCell.Offset(x, 6).Select = PDescription
                FoundMe = True
            'End If
            ActiveCell.Offset(x, 0).Select
'End If
'Else
        If CriteriaScore = "10 day Period" Then
            If AgentName = CriteriaName And RaisedD >= Startdate And RaisedDate <= Stopdate1 Then
                y = y + 1
                Sheets("Open").Select
                Range("C24").Select
                ActiveCell.Offset(y, 0).Value = RaisedD
                Range("C24").Select
                ActiveCell.Offset(y, 1).Value = DDAte
                Range("C24").Select
                ActiveCell.Offset(y, 3).Value = RefNo
                Range("C24").Select
                ActiveCell.Offset(x, 4).Select = Ptype
                Range("C24").Select
                ActiveCell.Offset(x, 6).Select = PDescription
                FoundMe = True
            End If
            ActiveCell.Offset(x, 0).Select
        End If
        
    Loop Until AgentName = ""
    
    If FoundMe = False Then
        MsgBox "Unable to Find any Quality Completed For " & CriteriaName & " for Quality Criteria " & CriteriaScore & ". Within the dates requested", vbOKOnly, "Please Try Again"
        FoundMe = True
    End If
    Sheets("Today").Select
 End If
 End If
 End If
End Sub
 

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
You can set intermediary Ifs with ElseIf. So if your first condition is blank, your second condition is it contains the number 3, else do your else part:

Code:
    If Range("E22") = "" Then
            Application.ScreenUpdating = True
            MsgBox "Please Select Work Load to check", vbOKOnly, "Missing Workload"
        Exit Sub
    ElseIf Range("E22") = 3 Then
        MsgBox "It is 3"
    Else
            criteriascore = Range("E22")
            
    End If

But if you're checking the same value for all conditions, you could use Select Case instead:


Code:
Select Case Range("E22")
    Case ""
        Application.ScreenUpdating = True
        MsgBox "Please Select Work Load to check", vbOKOnly, "Missing Workload"
        Exit Sub
    Case 3
        MsgBox "It is 3"
    Case Else
       CriteriaScore = Range("E22")
End Select
 
Upvote 0

Forum statistics

Threads
1,213,504
Messages
6,114,020
Members
448,543
Latest member
MartinLarkin

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