Check for values within Given Range

P

peerogel

Board Regular
Joined
Jan 25, 2011
Messages
108
I am trying to automate an annual leave calendar. I got stuck on looking for a value grater than 20% within a given Range.

Code: 
Sub NewTest()

Application.ScreenUpdating = False


Dim oSet As Integer
Dim StartDate As Range, EndDate As Range
oSet = 1

Dim q1 As Range, cel As Range, iName As Range
Set q1 = Sheets("Calendar").Range("B3:QO3")
Set iName = Sheets("Input").Range(Sheets("Input").Range("A6"), Sheets("Input").Range("A6").End(xlDown))

    For Each cel In iName
        
        Do Until cel.Offset(, oSet).Column() = 12
        If cel.Row() = 76 Then
            Debug.Print
        End If

        Set StartDate = q1.Find(What:=cel.Offset(, oSet))
        Set EndDate = q1.Find(What:=cel.Offset(, oSet + 1))
     
                   
                    If cel.Offset(, oSet) = "" Then
                    GoTo Skip
                    Else
                    Sheets("Calendar").Range(Sheets("Calendar").Cells(cel.Row() - 1, StartDate.Column()), Sheets("Calendar").Cells(cel.Row() - 1, EndDate.Column())).Value = "X"
                                       '***UPDATE SECOND OPTION
                   ' If Sheets("Calendar").Range(StartDate.Offset(1, 0), EndDate.Offset(1, 0)) >= 0.2 Then ' ***This works but only checks on the first given date
                    If Sheets("Calendar").Range(Sheets("Calendar").Cells(4 - 1, StartDate.Column()), Sheets("Calendar").Cells(4 - 1, EndDate.Column())).Value >= 0.2 Then '' Im trying to do something like this, where it will check between the first given date, the second date, and all cells in between the given range 
                    
                    Sheets("Calendar").Range(Sheets("Calendar").Cells(cel.Row() - 1, StartDate.Column()), Sheets("Calendar").Cells(cel.Row() - 1, EndDate.Column())).Value = ""
                    cel.Offset(, oSet).Interior.Color = 65535
                    cel.Offset(, oSet + 1).Interior.Color = 65535
                    cel.Offset(, oSet).Value = cel.Offset(, oSet + 35)
                    cel.Offset(, oSet + 1).Value = cel.Offset(, oSet + 36)
                    Application.ScreenUpdating = True
                    
                    
                    If cel.Offset(, oSet) = "" Then
                    GoTo Skip
                    Else
        Set StartDate = q1.Find(What:=cel.Offset(, oSet))
        Set EndDate = q1.Find(What:=cel.Offset(, oSet + 1))
                    Sheets("Calendar").Range(Sheets("Calendar").Cells(cel.Row() - 1, StartDate.Column()), Sheets("Calendar").Cells(cel.Row() - 1, EndDate.Column())).Value = "X"
                    Application.ScreenUpdating = False
                    End If
                    
                    Else
                    End If
                    
                    '***UPDATE THIRD OPTION
                    'If StartDate.Offset(1, 0).Value >= 0.2 Then
                    If Sheets("Calendar").Range(Sheets("Calendar").Cells(cel.Row() - cel.Row() + 3, StartDate.Column()), Sheets("Calendar").Cells(cel.Row() - cel.Row() + 3, EndDate.Column())).Value >= 0.2 Then
                    
                    Sheets("Calendar").Range(Sheets("Calendar").Cells(cel.Row() - 1, StartDate.Column()), Sheets("Calendar").Cells(cel.Row() - 1, EndDate.Column())).Value = ""
                    cel.Offset(, oSet).Interior.Color = 5296274
                    cel.Offset(, oSet + 1).Interior.Color = 5296274
                    cel.Offset(, oSet).Value = cel.Offset(, oSet + 45)
                    cel.Offset(, oSet + 1).Value = cel.Offset(, oSet + 46)
                    Application.ScreenUpdating = True
                    
                    
                    If cel.Offset(, oSet) = "" Then
                    GoTo Skip
                    Else
        Set StartDate = q1.Find(What:=cel.Offset(, oSet))
        Set EndDate = q1.Find(What:=cel.Offset(, oSet + 1))
                    Sheets("Calendar").Range(Sheets("Calendar").Cells(cel.Row() - 1, StartDate.Column()), Sheets("Calendar").Cells(cel.Row() - 1, EndDate.Column())).Value = "X"
                    Application.ScreenUpdating = False
                    End If
                    
                    Exit Sub
                    Else
                    End If
                    End If

Skip:
        oSet = oSet + 2
        Loop
        oSet = 1
'
    Next cel

Since the code puts an X in the range, I thought i could check on the range (row 4) for the value. I cant get it to work.Thanks in advance for your help.
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Sort by date Sort by votes
It's pretty hard to follow with so much relative referencing. Which line is producing the error and what type of error is it?
 
Upvote 0
It is a "Run-time error '13'" Type mismatch.

I've been trying to figure it out. So when I use the line as.
Code: 
Sheets("Calendar").Range(Sheets("Calendar").Cells(cel.Row() - 1, StartDate.Column()), Sheets("Calendar").Cells(cel.Row() - 1, EndDate.Column())).Value = "X"
It will put an "X" in a range given by the input sheet. So my Calendar has all days of the year. My input page only list the beginning day and the ending day. So that line puts an X on the Start date of the Calendar, End date of the Calendar and fills the dates in-between that range.

Underneath the dates, there is a formula that checks the percentage of people requesting that day of the year. So I was using this formula to make sure it did not go over the 20%.
Code: 
If Sheets("Calendar").Range(StartDate.Offset(1, 0), EndDate.Offset(1, 0)) >= 0.2
But if I use that formula it will only check the Start day of the range and I need it to check every day of that range.

Trying to figure out the error I tried the following line.
Code: 
Range("A1").value=Sheets("Calendar").Range(Sheets("Calendar").Cells(4 - 1, StartDate.Column()), Sheets("Calendar").Cells(4 - 1, EndDate.Column())).Value
A1 returns with the starting date of the range. Not sure if this is why I keep getting the error.

I will clean a workbook later today and attach it, hopefully it makes more sense. Thanks.
 
Upvote 0
HTML: 
https://www.dropbox.com/s/2pgcbxpbd6awn07/testCalendar.xlsm?dl=0

Hopefully this makes more sense. So the code is suppose to go down the list and plug into the calendar the employee date range. if the date range is over the 20%, it looks for the employees second option, plugs it in back in the input and re-runs that loop and again if the second option is over the 20% it looks for the employees third option and plugs it back in the input and re-runs the code.

However, the way it is set up right now. It only checks the first day of the date range and I need to make sure that the entire date range is below the 20%. If any of those days in the date range falls above the 20%, i want it go through the second and thirds options.
 
Upvote 0
This is the code that is suppose to be in the workbook. In case i forgot to attach it.
Code: 
Sub NewTest()

Application.ScreenUpdating = False


Dim oSet As Integer
Dim StartDate As Range, EndDate As Range
oSet = 1

Dim q1 As Range, cel As Range, iName As Range
Set q1 = Sheets("Calendar").Range("B3:QO3")
Set iName = Sheets("Input").Range(Sheets("Input").Range("A6"), Sheets("Input").Range("A6").End(xlDown))

    For Each cel In iName
        
        Do Until cel.Offset(, oSet).Column() = 12
        If cel.Row() = 76 Then
            Debug.Print
        End If

        Set StartDate = q1.Find(What:=cel.Offset(, oSet))
        Set EndDate = q1.Find(What:=cel.Offset(, oSet + 1))
     
                   
                    If cel.Offset(, oSet) = "" Then
                    GoTo Skip
                    Else
                    Sheets("Calendar").Range(Sheets("Calendar").Cells(cel.Row() - 1, StartDate.Column()), Sheets("Calendar").Cells(cel.Row() - 1, EndDate.Column())).Value = "X"
                                       '***UPDATE SECOND OPTION
                    If StartDate.Offset(1, 0).Value >= 0.2 Then
                    'If Sheets("Calendar").Range(Sheets("Calendar").Cells(4 - 1, StartDate.Column()), Sheets("Calendar").Cells(4 - 1, EndDate.Column())).Value >= 0.2 Then
                    
                    Sheets("Calendar").Range(Sheets("Calendar").Cells(cel.Row() - 1, StartDate.Column()), Sheets("Calendar").Cells(cel.Row() - 1, EndDate.Column())).Value = ""
                    cel.Offset(, oSet).Interior.Color = 65535
                    cel.Offset(, oSet + 1).Interior.Color = 65535
                    cel.Offset(, oSet).Value = cel.Offset(, oSet + 35)
                    cel.Offset(, oSet + 1).Value = cel.Offset(, oSet + 36)
                    Application.ScreenUpdating = True
                    
                    
                    If cel.Offset(, oSet) = "" Then
                    GoTo Skip
                    Else
        Set StartDate = q1.Find(What:=cel.Offset(, oSet))
        Set EndDate = q1.Find(What:=cel.Offset(, oSet + 1))
                    Sheets("Calendar").Range(Sheets("Calendar").Cells(cel.Row() - 1, StartDate.Column()), Sheets("Calendar").Cells(cel.Row() - 1, EndDate.Column())).Value = "X"
                    Application.ScreenUpdating = False
                    End If
                    
                    Else
                    End If
                    
                    '***UPDATE THIRD OPTION
                    If StartDate.Offset(1, 0).Value >= 0.2 Then
                    'If Sheets("Calendar").Range(Sheets("Calendar").Cells(cel.Row() - cel.Row() + 3, StartDate.Column()), Sheets("Calendar").Cells(cel.Row() - cel.Row() + 3, EndDate.Column())).Value >= 0.2 Then
                    
                    Sheets("Calendar").Range(Sheets("Calendar").Cells(cel.Row() - 1, StartDate.Column()), Sheets("Calendar").Cells(cel.Row() - 1, EndDate.Column())).Value = ""
                    cel.Offset(, oSet).Interior.Color = 5296274
                    cel.Offset(, oSet + 1).Interior.Color = 5296274
                    cel.Offset(, oSet).Value = cel.Offset(, oSet + 45)
                    cel.Offset(, oSet + 1).Value = cel.Offset(, oSet + 46)
                    Application.ScreenUpdating = True
                    
                    
                    If cel.Offset(, oSet) = "" Then
                    GoTo Skip
                    Else
        Set StartDate = q1.Find(What:=cel.Offset(, oSet))
        Set EndDate = q1.Find(What:=cel.Offset(, oSet + 1))
                    Sheets("Calendar").Range(Sheets("Calendar").Cells(cel.Row() - 1, StartDate.Column()), Sheets("Calendar").Cells(cel.Row() - 1, EndDate.Column())).Value = "X"
                    Application.ScreenUpdating = False
                    End If
                    
                    Exit Sub
                    Else
                    End If
                    End If

Skip:
        oSet = oSet + 2
        Loop
        oSet = 1
'
    Next cel

Application.ScreenUpdating = True
End Sub
 
Upvote 0
peerogel said:
Code: 
If Sheets("Calendar").Range(StartDate.Offset(1, 0), EndDate.Offset(1, 0)) >= 0.2
But if I use that formula it will only check the Start day of the range and I need it to check every day of that range.
Click to expand...

No, if you use that formula, you'll get a type mismatch error because you're trying to compare an array of values with a single value 0.2.

(But if you try to put an array into a single cell, as you tried with A1, then the cell will accommodate only the first value in the array).

If you want the condition to test whether any value in the range is >=0.2, use:

Code: 
If Application.Max(Range(StartDate, EndDate).Offset(1)) >=0.2 Then
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Solved
Copy/paste a row from within a loop, before that loop moves on to next cell
Replies
5
Views
525
Joe4
Joe4
N
  • Solved
Excel 2016 VBA - Pull data from multiple sheets to One with specificities
Replies
3
Views
298
mumps
mumps
T
  • Solved
VBA Macro to sort table by vendor copy table into email body and send, then do the same for the next vendor in the table to the last vendor
Replies
5
Views
1K
takingiwhanau
T
Anigito
  • Question Question
Get Webpage Title Text by URL Generated in MS Excel
Replies
1
Views
1K
Anigito
Anigito
M
  • Solved
How to check if a cell text matches the cell format.
2
Replies
19
Views
1K
Macro_Nerd99
M

Forum statistics

Threads
1,223,789
Messages
6,174,571
Members
452,573
Latest member
Cpiet

Share this page

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