Run report that information that is dependant on matching cells.

[happyexcelperson]

Hi everyone,

I need to have a report run that shows everyone who is currently on "Time Off".
I am able to search for the date with the code below, but It does not work at all as intended

What needs to happen is this:
1. Search the row for todays date, then
2. check the cell just above the date found, and if it says "Time Off" then,
3. Copy the cell from Column B of that row, then,
4. Move on to the next row (note: there might be multiple dates in the row that is todays date, but I just need it to show up once for it to copy and paste the cell from column b"), then;
5. do the same for all sheets except for sheet "Not Employed"

The code I have does step 1 and 5 correctly, but it does not do 2-4 and I can not figure out how to edit it to do that.

Here is the code:

Sub Workbook_Open()

Range("f4:i700").FormulaR1C1 = Clear
Dim sh As Worksheet, rng As Range, c As Range, fsh As Worksheet
Set sh = Sheets("Overview")
    For Each fsh In ThisWorkbook.Sheets
        If fsh.Name <> "Not Employed" Then
            Set rng = fsh.Range("a1:det122")
            For Each c In rng
                If c.Value = Date Then
                    c.Offset(rc2).Copy '<------I need it to copy column B and paste just the cell in column B
                    If sh.Cells(Rows.Count, 6).End(xlUp)(2).Row < 5 Then
                        sh.Range("f4").PasteSpecial xlPasteValues
                    Else
                        sh.Cells(Rows.Count, 6).End(xlUp)(2).PasteSpecial xlPasteValues
                    End If
                End If
            Next
        End If
    Next

End Sub

Can someone please help me?

[xladept]

Hi Happy,

See if this is what you want:

Sub Workbook_Open()

Range("f4:i700").FormulaR1C1 = Clear
Dim sh As Worksheet, rng As Range, c As Range, fsh As Worksheet, r As Long
Set sh = Sheets("Overview"): r = sh.Range("F" & Rows.Count).End(xlUp).row
    For Each fsh In ThisWorkbook.Sheets
        If fsh.Name <> "Not Employed" Then
            Set rng = fsh.Range("a1:det122")
            For Each c In rng
                If c.Value = Date Then
                    Range(c.row, 2).Copy 'to copy just the cell in column B
                    If r < 5 Then
                    sh.Range("F4").PasteSpecial xlPasteValues
                    Else
                    sh.Range("F" & r + 2).PasteSpecial xlPasteValues
                    End If
                End If
            Next
        End If
    Next

End Sub

[happyexcelperson]

xladept. Thank you so much for taking the time to look at this. I tried the code and I keep getting an error, "Run-time Error 1004 - Method 'range' of object '_Global' Failed. I did not mention that I am on excel 2010.

Also, this this code does not do the part 2 of what I need (at least not that I can see).

[happyexcelperson]

I really appologize for not responding earlier. My folks flew in a few days ago and I haven't been online till now. I will test this out and see if it works. I'll let you know.

[AB33]

Untested,
I have adjusted two lines of your code.

IMO, this code will be very slow as the code has to loop through more than 1000 columns. It may be a bit faster to use a find and match function code.

Sub Workbook_Open()

Range("f4:i700").FormulaR1C1 = Clear
Dim sh As Worksheet, rng As Range, c As Range, fsh As Worksheet
Set sh = Sheets("Overview")
    For Each fsh In ThisWorkbook.Sheets
        If fsh.Name <> "Not Employed" Then
            Set rng = fsh.Range("a1:det122")
            For Each c In rng
                If c.Value = Date And c.Offset(-1) = "Time Off" Then
                    Cells(c.Row, "B").Copy '<------I need it to copy column B and paste just the cell in column B
                    If sh.Cells(Rows.Count, 6).End(xlUp)(2).Row < 5 Then
                        sh.Range("f4").PasteSpecial xlPasteValues
                    Else
                        sh.Cells(Rows.Count, 6).End(xlUp)(2).PasteSpecial xlPasteValues
                    End If
                End If
            Next
        End If
    Next

End Sub

[xladept]

Hi Happy,

It looks like it choked on:

Range(c.row, 2).Copy

my bad

which should have been written as:

Cells(c.row, 2).Copy

And AB33 fixed that so AB33's code should run for you

[happyexcelperson]

Hi AB33 and xladept,

Again, I apologize for the late response. I really appreciate both of you taking the time.
I don't know if it is because I'm using excel 2010, but I'm still getting an error when it runs.
It highlights this line:

If c.Value = Date And c.Offset(-1) = "Time Off" Then

and gives this error:
"Run-time error '1004':

Application-defined or object defined error"

I don't know if the problem is "date" (I've had trouble using date on 2013) or "and" (I've had trouble adding and functions in the past). Please let me know. I really appreciate your help.

[AB33]

It is most likely the date.
Try this one and if it does not work, we need to see your sample

If c.Value = cd(Date) And c.Offset(-1) = "Time Off" Then

[happyexcelperson]

The new line is showing that cd(date) is undefined.

I'm going to make a dummy version (due to the fact there may be some proprietary information). I'll post it shortly.

[AB33]

Do you have a variable for a c? If so, how is declared, and if you do not have, may be try to declare it as?

c as date

[happyexcelperson]

I tried that. I get "compile error: For each must be variant or Object" I believe thats why I declared c as range.

Here is the file.

A couple notes:
1. the script in this is actually called currentlyoff
2. it is the last code on Module 1
3. There are a few minor changes in this code than the one posted (things like unprotect, and the search criteria)
4. The button that runs the code is "Refresh List" on the Overview Tab
5. The color buttons don't work since I had to make the size smaller to allow it to attach.

dummyoccurrences.xlsm

[AB33]

Few problem with the code

 Set rng = fsh.Range("a1:det122")

and

c.Offset(-1) = "Time Off" Then

will give an error if a1 has a value and trying to go up 1(c.Offset(-1)), which does not exist, so a1 should change to a2

 Set rng = fsh.Range("a2:det122")

I do not know the reason the code does not like the date function, but when I tried now, instead of date it works.

 If c = Now And c.Offset(-1) = "Time Off" Then

I need to look why date gives an error

[AB33]

Okay,
I have run your code in my sheet, but did not get an error with the date function. This is really weird.

[happyexcelperson]

Okay, so the code now runs without error, but it is coming back as no response. There should be 2 responses (c. john doe and e. john doe). Could it be because "now" has a timestamp and the dates it is searching does not?

And did it return responses when you ran it?

[AB33]

Are you using the date or now function?
Please run it by stepping over using F8 and see if the code finds any cell if the if statement is true and examine that cell. If you are using the date function and code does not return any, it could be that there is no data with today' date.

[happyexcelperson]

I used the now function. There are definately dates that match today, I have conditional formatting where the name cell shades purple if it matches time off request and todays date. Also I unhid those rows to verify and they are there.

[happyexcelperson]

Maybe instead can I have it check if that particular conditional formatting is present, and if so copy the name?

That might make it easier. But I don't know how to have it look at conditional formatting.

[happyexcelperson]

AB33,
I do see your point on it taking time to run. When you say "It may be a bit faster to use a find and match function code" How might I do that instead. Basically, all I need is if there todays date in the row, and "time off request" is in the cell directly above the date, then copy the cell in column b and move on to the next row. If there is a better way to do that I would rather do that. I am not married to my code.

[happyexcelperson]

I decided to completely rethink the way I ran this report. I simply added a column with this formula: =SUMPRODUCT(--(R[-2]C[1]:R[-2]C[16371]=""Time Off Request""),--(R[-1]C[1]:R[-1]C[16371]=TODAY()))>0

Then I used this code:

Sub timeofflist()
ActiveSheet.Unprotect
Range("l6:l700").FormulaR1C1 = Clear
Dim sh As Worksheet, rng As Range, c As Range, fsh As Worksheet
Set sh = Sheets("Overview")
    For Each fsh In ThisWorkbook.Sheets
        If fsh.Name <> "Not Employed" Then
            Set rng = fsh.Range("m5:m122")
            For Each c In rng
                If c.Value = True Then
                    c.Offset(0, -11).Copy
                    If sh.Cells(Rows.Count, 12).End(xlUp)(2).Row < 5 Then
                        sh.Range("l6").PasteSpecial xlPasteValues
                    Else
                        sh.Cells(Rows.Count, 12).End(xlUp)(2).PasteSpecial xlPasteValues
                    End If
                End If
            Next
        End If
    Next
ActiveSheet.Protect
End Sub

Thank you to everyone who responded. This was a big project that I can now call complete thanks to you guys!