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

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
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,551
Messages
6,114,266
Members
448,558
Latest member
aivin

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