Extract Time Values from Other Sheets

[CaptRon]

My workbook has six worksheets. On the first five weekly activity worksheets, B11:B17 contains a date, D11:17 contains the beginning shift time, and F11:F17 holds the ending shift time for each date.

On the last worksheet, the users account for overtime worked. For each date where OT is worked, they must enter the date, time shift started and ended, explanation of duties, etc.

I?d like the user to be able to enter a date in Column A (Date Worked) on the OT sheet, and have Excel populate cells on the same row in the Column B (Start Shift) and Column C (End Shift) with time values that correspond to the same date in B11:B17 on the first 5 worksheets.

Would this be possible using VBA? Thanks for your help.

Ron

[Bob Phillips]

Post a workbook for us to work with.

[Simon Lloyd]

if the dates are unique in B11:B17 then you need only use Vlookup like this:


=IF(ISNA(VLOOKUP(A1,Sheet1!B11:B17,2,FALSE)),"",VLOOKUP(A1,Sheet1!B11:B17,2,FALSE))
and so on for the next cell.

[Simon Lloyd]

Ahhh!, i didn't read the question fully, the vlookup only returns a value from sheet 1 but you would like the value from sheets 1,2,3,4,5 all one under the other in the sheet the user is using, is that correct?

[Simon Lloyd]

Maybe try this!

Sub Find_Date_Copy()
Dim Rng As String
Dim i As Integer, C As Integer
Dim MySheet As String
MySheet = ActiveSheet.Name
C = 0
For i = 1 To Sheets.Count
If Sheets(i).Name = MySheet Then Exit Sub
With Sheets(i)
Rng = .Cells.Find(What:=ActiveCell.Value, After:=Sheets(i).Range("B10"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Address
End With

ActiveCell.Offset(C, 1).Value = Sheets(i).Range(Rng).Offset(0, 1).Value
ActiveCell.Offset(C, 2).Value = Sheets(i).Range(Rng).Offset(0, 2).Value
C = C + 1
Next i
End Sub
Remember it is looking for the value of the Activecell!
JUST EDITED 09:51 'COS I MISSED A QUALIFIER OUT - Didn't want to offend Bob!

[CaptRon]

My workbook has six worksheets. On the first five weekly activity worksheets, B11:B17 contains a date, D11:17 contains the beginning shift time, and F11:F17 holds the ending shift time for each date.

On the last worksheet, the users account for overtime worked. For each date where OT is worked, they must enter the date, time shift started and ended, explanation of duties, etc.

I?d like the user to be able to enter a date in Column A (Date Worked) on the OT sheet, and have Excel populate cells on the same row in the Column B (Start Shift) and Column C (End Shift) with time values that correspond to the same date in B11:B17 on the first 5 worksheets.

Would this be possible using VBA? Thanks for your help.

Ron

[tstav]

Hi Ron,
I suppose that the ranges D11: D17 and F11:F17 are formatted as Time (hh:mm), right? In case they are not, then I suppose they are filled like the hh:mm format (e.g. 8:15, 16:20 etc.)

The following code does what you asked for. Place it in the "overtime" Worksheet (I call it "OT" in the code).

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Sht As Worksheet, cell As Range
On Error GoTo ErrorHandler
'Only if they write in column A
If Not Intersect(Target, Columns("A")) Is Nothing Then
'If not a date, alert
If Not IsDate(Target.Value) Then
MsgBox "This is not a date", , "Error"
Target.Select
Exit Sub
End If

'If date, look for it
For Each Sht In Worksheets
If Sht.Name <> "OT" Then '<--Change this to the OverTime_Worksheet_Name
With Sht.Range("B11:B17")
Set cell = .Find(what:=CDate(Target.Value), LookIn:=xlValues, LookAt:=xlWhole)
If Not cell Is Nothing Then 'found it
Exit For
End If
End With
End If
Next 'Sht

'If date found, write ShiftTimes
If Not cell Is Nothing Then
Application.EnableEvents = False
Target.Offset(0, 1).NumberFormat = "h:mm"
Target.Offset(0, 1).Value = cell.Offset(0, 2).Value
Target.Offset(0, 2).NumberFormat = "h:mm"
Target.Offset(0, 2).Value = cell.Offset(0, 4).Value

'if date not found, alert
Else
MsgBox "Date not found", , "Not found"
Target.Select
End If
End If
ErrorHandler:
Application.EnableEvents = True
End Sub

[BreakfastGuy]

Answered earlier in this thread (http://www.vbaexpress.com/forum/showthread.php?t=18336)

[tstav]

Edit to my previous post:
You may change the
Target.Offset(0, 1).NumberFormat = "h:mm"
Target.Offset(0, 1).Value = cell.Offset(0, 2).Value

to
Target.Offset(0, 1).Value = Format(cell.Offset(0, 2).Value, "h:mm")

[tstav]

From BreakfastGuy:Answered earlier in this thread (http://www.vbaexpress.com/forum/showthread.php?t=18336)

I see... It was a double post then... Thanks BreakfastGuy, hadn't noticed. Sorry everybody!

[BreakfastGuy]

tstav you gave a better answer for the application though, it would probably suit the Op better!

[lucas]

threads merged....

no apology necessary tstav......how were you to know?

nice catch breakfastguy.....

[CaptRon]

Didn't mean to post this twice. I worked on it til late last night then decided I'd try to get some help. I thought I had posted my message before I went to bed, but I saw it was still on my screen this morning. I didn't find it posted to the forum so I figured I hadn't submitted it after all.

Here's a copy of the workbook. I've tried the solutions offered so far and haven't had much luck yet. Had to cut this down quite a bit to get under the 244kb limit, so there's only 3 sheets in this sample.

Thanks,

Ron

[BreakfastGuy]

B11:B17 contains a dateit doesn't it contains a series of calculations ending in a number!

[CaptRon]

Yes, you are correct. It contains a formula with the resulting value displayed as the day of the month. I should have noted that. My mistake.

Ron

[BreakfastGuy]

Put this in the OT Memo worksheet module, doesn't look for a date now just the number will do what you want!

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Sht As Worksheet, cell As Range
On Error GoTo ErrorHandler
'Only if they write in column A
If Not Intersect(Target, Columns("A")) Is Nothing Then

For Each Sht In Worksheets
If Sht.Name <> "OT Memo" Then '<--Change this to the OverTime_Worksheet_Name
With Sht.Range("B10:B17")
Set cell = .Find(what:=Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not cell Is Nothing Then 'found it
Exit For
End If
End With
End If
Next 'Sht

'If date found, write ShiftTimes
If Not cell Is Nothing Then
Application.EnableEvents = False
Target.Offset(0, 1).Value = Format(cell.Offset(0, 2).Value, "h:mm")
Target.Offset(0, 3).Value = Format(cell.Offset(0, 3).Value, "h:mm")

'if number not found, alert
Else
MsgBox "Number not found", , "Not found"
Target.Select
End If
End If
ErrorHandler:
Application.EnableEvents = True
End Sub

[CaptRon]

Thanks for the quick reply, BG.

However, I still can't get this code to work. Don't know what I'm doing wrong. I copied it into the OT Memo worksheet module, then entered a date from Report 1 on Column A of the OT Memo. I get the "Number not found." message. I need to change something somewhere.

Ron

[BreakfastGuy]

well of course!!!!!!!!!!!!!!!!! you said it yourself....you entered a date!, try just entering the number i.e 28 or 30 etc.

Worked for me!

[CaptRon]

I removed the validation from Column A, OT Memo, reformatted to a number (no decimals) and altered the code to produce h:mm A/P result. Works great. Thanks.

The something I'm going to have to change, though, relates to the date issue. On the Report sheets, I'm stuck with day (28, 29, 30, etc.) in column B.

On the OT Memo, the user will enter a date m/d/yy, not just the day. I will have to reconcile this somehow.

Ron

[BreakfastGuy]

so why not just have the date in column b of the report sheet? then custom format the cell(s) as dd?

So column A that has the day put the full date in and custom format ddd
Column B enter full date custom format dd, if you wanted the month figure then format as mm if you want the month name format as mmm...get the idea? then you can go back to the original code by tstav, don't forget the amendments!

[BreakfastGuy]

On second thoughts in column A enter this formula:


=TEXT(WEEKDAY(B1), "ddd")
this will show the abbreviated day name for the contents of B1

[CaptRon]

BG, thanks for hanging in there with me on this.

Because of the 244kb limit on the forum, I actually went with the supervisor's workbook, not the trooper's workbook, as it was easier to trim down. Consequently, the range references for the activity sheets are slightly off from my original post (B10:B16 rather than B11:B17).

The full workbook is comprised of several sheets that the officers need to complete for their paperwork for the 28-day work period. To make this as simple for them as possible, I start the workbook with a setup page where they enter their name, duty station, SS#, ID#, etc., AND the beginning date of the work period. There are approximately 13 28-day work periods in a year. Usually, 2 or 3 of them begin and finish in the same month, requiring only 4 weekly activity reports. For the other work periods where a week begins with one month and ends with another, 5 activity reports are required.

So......I devised this scheme of formulas (AH234:AP248) to look at the beginning date of the period and populate the entire workbook with the correct dates wherever needed.

That's why the formulas occupy B10:B16 on the activity sheets. Perhaps I could use VBA to place the date values in another column out of the way and refer to it instead of B10:B16.

If you care to, you can view the full workbook at:
http://www.keepandshare.com/doc/view.php?u=455124

Thanks,

Ron

[BreakfastGuy]

You possibly could and it would be as messy as the area you have used below all your data, however the formulae in B10..etc could be given up for just allowing them to enter the date custom format to dd, use Data validation and allow only a date (in the dates between boxes just type the start and end dates) in column A enter the formula above and hey presto! the sheet looks the same only the cell in column B now houses a complete date which you can look for with the code, you can also use Data Validation on column A there too to restrict date entry!

[CaptRon]

While the formula block is messy, it's out of the way and functional. I'll try to figure something out. Thanks for all you help.

Ron