Project Labour Sheet - Query text and return corresponding results

[webbooo]

http://onedrive.live.com/redir?resid=C793CA7C52E2A4A2!105
Hello,

Hoping someone can help with this. I have the attached Labour/Time entry for a project I'm managing.

What I would like to do is query a users surname via an entry field and for every row it finds I would like to return the cumulative total dollar figure specific to that user in Column C.

ie, be able to search 'Summers' would return a total dollar amount of $56,790

The second component I would like to achieve is to search a surname for a particular month and return the figure in column "c" for the surname + month

ie, 'Bert' search for January 2014 would return $136.46

Using Filter lets me get the results eventually but I'd like to be able to have an entry field or similar that returns the data. My actual sheets contain 100's of rows and the surname text can be surrounded by other text that is irrelevant.



Hopefully someone can help otherwise I'll stick to custom filters.

Thank in advance

Adam

 

[venkat1926]

I shall prepare a macro. wait for a day. meanwhile a doubt what if two different people has same surnames???????

 

[venkat1926]

check col B of row no. 108 . I have accepted it as it is
some of the names are having unnecessary spaces at the end.
I used trim function (macro surname) to remove them
helper column E extracts surnames from column B temorarily
run only "final macro"
see sheet 2 for results
modify macros if necessary

can you follow this example and write a macro for each month and each surname. if you go through the code you can extract the month also in another column F

any problem revert back


the macros are

Sub surname()
Dim rname As Range, c As Range
Set rname = Range(Range("B2"), Range("B2").End(xlDown))
For Each c In rname
c = Trim(c)
Next c
For Each c In rname
Cells(c.Row, "E") = Right(c, (Len(c) - WorksheetFunction.Search(",", c)))
Next c
Cells(1, "E") = "surname"
End Sub

Sub test()
Dim rsurname As Range, rdata As Range, filt As Range, surnam As String, subtot As Double, cfilt As Range
Dim dest As Range
Worksheets("sheet2").Cells.Clear
Worksheets("sheet1").Activate
Set rdata = Range("A1").CurrentRegion
Set rsurname = rdata.Columns("E:E")
Set filt = Range("A1").End(xlDown).Offset(5, 0)
rsurname.AdvancedFilter xlFilterCopy, , filt, True
Set filt = Range(filt.Offset(1, 0), filt.End(xlDown))
For Each cfilt In filt
surnam = cfilt
rdata.AutoFilter field:=Range("E1").Column, Criteria1:=surnam
subtot = WorksheetFunction.Subtotal(109, rdata.Columns("C:C"))
With Worksheets("sheet2")
Set dest = .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
dest = surnam
dest.Offset(0, 1) = subtot
End With
ActiveSheet.AutoFilterMode = False
Next cfilt


Range(Range("A1").End(xlDown).Offset(1, 0), Cells(Rows.Count, "A").End(xlUp)).EntireRow.Cells.Clear
Range("E1").EntireColumn.Delete
End Sub

Sub finalmacro()
Application.ScreenUpdating = False
surname
test
MsgBox "macro done"
Application.ScreenUpdating = True


End Sub