Help to complete a code

Hello
I'm sorry but I don't speak english very well
I want you to help me to complete a code
http://img95.echo.cx/img95/6123/sanstitre5yr.jpg

I have this code :

Code:

---

Sub Extract()
  Dim bSheetExists As Boolean 
  Dim iNextRow As Long
  Dim rActivity As Range
  Dim rHeading As Range
  Dim vI As Variant
  Dim vJ As Variant
  Sheets("Data").Activate
  Set rActivity = Range([A2], [A2].End(xlDown))                                                 
  Set rHeading = Rows(1) 
  For Each vI In rActivity 
    bSheetExists = False 
    For Each vJ In Worksheets 
      If vJ.Name = vI.Cells(1, 6) Then                                       
        bSheetExists = True 
        Exit For             
      End If
    Next vJ 
    If bSheetExists Then 
      vJ.Activate           
    Else                                               
      Worksheets.Add After:=Worksheets(Worksheets.Count)                                                         
      ActiveSheet.Name = vI.Cells(1, 6) 
rHeading.Copy ([A1]) 
    End If
    iNextRow = [A1].SpecialCells(xlLastCell).Row + 1 
vI.EntireRow.Copy (Cells(iNextRow, 1))       
Next vI   
End Sub

---

This code take automatically all the lines of the sheet and create a new sheet by user (utilisateur)
But I want it to create a new sheet only for a specified user that I give in a msg box

I hope you'll understand me
Thank you for your help

Here is an amended routine.

call like Extract "gabri012"

Code:

---

Sub Extract(user As String)
Dim bSheetExists As Boolean
Dim iNextRow As Long
Dim rActivity As Range
Dim rHeading As Range
Dim vI As Variant
Dim vJ As Variant
Sheets("Data").Activate
Set rActivity = Range([A2], [A2].End(xlDown))
Set rHeading = Rows(1)
For Each vI In rActivity
If vI.Offset(0, 5).Value = user Then
bSheetExists = False
For Each vJ In Worksheets
If vJ.Name = vI.Cells(1, 6) Then
bSheetExists = True
Exit For
End If
Next vJ
If bSheetExists Then
vJ.Activate
Else
Worksheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = vI.Cells(1, 6)
rHeading.Copy ([A1])
End If
iNextRow = [A1].SpecialCells(xlLastCell).Row + 1
vI.EntireRow.Copy (Cells(iNextRow, 1))
End If
Next vI
End Sub

---

euh..
I need to specify the user in an input box
and extract data in a new sheet only for him
thanks but it doesn't works

Quote:

---

Originally Posted by atmakefka

euh..
I need to specify the user in an input box
and extract data in a new sheet only for him
thanks but it doesn't works

---

It does.

Code:

---

ans = InputBox("Input user name")
    If ans <> "" Then
        Extract ans
    End If

---

Ok, but there's 2 codes ?I'm sorry I don't understand
Could you give me the "full" or unique code ?
thanks

Code:

---

Sub Extract()
ans = InputBox("Input user name")
If ans <> "" Then
ExtractByUser ans
End If
End Sub
 
Sub ExtractByUser(user As String)
Dim bSheetExists As Boolean
Dim iNextRow As Long
Dim rActivity As Range
Dim rHeading As Range
Dim vI As Variant
Dim vJ As Variant
Sheets("Data").Activate
Set rActivity = Range([A2], [A2].End(xlDown))
Set rHeading = Rows(1)
For Each vI In rActivity
If vI.Offset(0, 5).Value = user Then
bSheetExists = False
For Each vJ In Worksheets
If vJ.Name = vI.Cells(1, 6) Then
bSheetExists = True
Exit For
End If
Next vJ
If bSheetExists Then
vJ.Activate
Else
Worksheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = vI.Cells(1, 6)
rHeading.Copy ([A1])
End If
iNextRow = [A1].SpecialCells(xlLastCell).Row + 1
vI.EntireRow.Copy (Cells(iNextRow, 1))
End If
Next vI
End Sub

---

"argument ByRef incompatible"

Sorry, my error

Code:

---

Sub Extract()
Dim ans
ans = InputBox("Input user name")
If ans <> "" Then
ExtractByUser CStr(ans)
End If
End Sub
 
Sub ExtractByUser(user As String)
Dim bSheetExists As Boolean
Dim iNextRow As Long
Dim rActivity As Range
Dim rHeading As Range
Dim vI As Variant
Dim vJ As Variant
Sheets("Data").Activate
Set rActivity = Range([A2], [A2].End(xlDown))
Set rHeading = Rows(1)
For Each vI In rActivity
If vI.Offset(0, 5).Value = user Then
bSheetExists = False
For Each vJ In Worksheets
If vJ.Name = vI.Cells(1, 6) Then
bSheetExists = True
Exit For
End If
Next vJ
If bSheetExists Then
vJ.Activate
Else
Worksheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = vI.Cells(1, 6)
rHeading.Copy ([A1])
End If
iNextRow = [A1].SpecialCells(xlLastCell).Row + 1
vI.EntireRow.Copy (Cells(iNextRow, 1))
End If
Next vI
End Sub

---

thanks !! :):)

I need your help again :/

I have 2 codes to find:

One which caculate the connection time for a specified/given/provided user and period (inputbox^^)

and an another which count the number of sessions opened/connexions for a specified/given/provided user and period, ignoring those under 1 minute during

I have this :

http://img25.echo.cx/img25/9185/13nl.jpg

Column B : The date where the user connected/opened his session
Column D : The date where the user disconnected/closed his session
Column C : The hour he opened
Column E : The hour he closed
Column F : the user/login

I don't know how to do, it seems to be complicated :/
any idea to help me?
thanks

Can we just use worksheet formulae for this?

no, it must be a macro :(

Do you want all of those totals just added to the foot of the new worksheets?

I'm not sure if I had really understood your question
The results must appear in msg box I think

I am suggesting adding them to the sheet for the selected user. More permannent. Post your workbook to give me some valid test data, and I will then post the amendment.

Right :)
Here's a link to the workbook
http://kof54.free.fr/data.xls

thanks ! ;)

Code:

---

Sub Extract()
Dim sName, dteStart, dteEnd
Dim oSheetUser As Worksheet
Dim iNextRow As Long
Dim rActivity As Range
Dim rHeading As Range
Dim vI As Variant
Dim vJ As Variant
Dim iLastRow As Long
Dim sFormula As String
sName = InputBox("Input user name")
If sName = "" Then
Exit Sub
Else
dteStart = InputBox("Input start date")
If dteStart = "" Or Not IsDate(dteStart) Then
Exit Sub
Else
dteEnd = InputBox("Input end date")
If dteEnd = "" Or Not IsDate(dteStart) Then
Exit Sub
End If
End If
End If
Sheets("Data").Activate
Set rActivity = Range([A2], [A2].End(xlDown))
Set rHeading = Rows(1)
On Error Resume Next
Set oSheetUser = Worksheets(sName)
On Error GoTo 0
If oSheetUser Is Nothing Then
Set oSheetUser = Worksheets.Add(After:=Worksheets(Worksheets.Count))
oSheetUser.Name = sName
End If
oSheetUser.Cells.ClearContents
rHeading.Copy oSheetUser.[A1]
iNextRow = 2
For Each vI In rActivity
If vI.Offset(0, 5).Value = sName Then
vI.EntireRow.Copy (oSheetUser.Cells(iNextRow, 1))
iNextRow = iNextRow + 1
End If
Next vI
With oSheetUser
iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
With .Range("A" & iLastRow + 2)
.Value = "Connection time for period " & _
Format(dteStart, "dd mmm yyyy") & " to " & _
Format(dteEnd, "dd mmm yyyy")
sFormula = "=SUMPRODUCT(" & _
"--(B2:B" & iLastRow & ">=--""" & Format(dteStart, "yyyy/mm/dd") & """)," & _
"--(D2:D" & iLastRow & "<=--""" & Format(dteEnd, "yyyy/mm/dd") & """)," & _
"(E2:E" & iLastRow & "-C2:C" & iLastRow & "))"
.Offset(0, 6).Formula = sFormula
.Offset(0, 6).NumberFormat = "[hh]:mm:ss"
.Offset(2, 0).Value = "Connections for period " & _
Format(dteStart, "dd mmm yyyy") & " to " & _
Format(dteEnd, "dd mmm yyyy")
sFormula = "=SUMPRODUCT(" & _
"--(B2:B" & iLastRow & ">=--""" & Format(dteStart, "yyyy/mm/dd") & """)," & _
"--(D2:D" & iLastRow & "<=--""" & Format(dteEnd, "yyyy/mm/dd") & """)," & _
"--((E2:E" & iLastRow & "-C2:C" & iLastRow & ")>=--""00:01:00""))"
.Offset(2, 6).Formula = sFormula
.Offset(2, 6).NumberFormat = "#,##0"
End With
.Activate
End With
End Sub

---

woow gg ! thanks for all !

I need juste to separate in two codes :/
thanks again

Quote:

---

Originally Posted by atmakefka

I need juste to separate in two codes

---

Sorry, can you re-phrase that as I don't understand?

Sorry,
In fact I need two programs, yours rocks, but I need

One which caculate the connection time for a specified/given/provided user and period

The another which count the number of sessions opened/connexions for a specified/given/provided user and period, ignoring those under 1 minute during

Yours is good but does both at the same time^^
just that

Quote:

---

Originally Posted by atmakefka

In fact I need two programs,

...

Yours is good but does both at the same time^^

---

Surely, if you get both at the same time isn't that better, why would each individually be preferred?

If you must have individulaly, how do you decide which?

Also I think we (you) need a better input method, inputboxes are flaky.

Your right, anyway thanks for all :)

Hello
I need one again your talent

I have 2 sheets (always the same...) :

http://img25.echo.cx/img25/9185/13nl.jpg
Column B : The date where the user connected/opened his session
Column D : The date where the user disconnected/closed his session
Column C : The hour he opened
Column E : The hour he closed
Column F : the user/login

http://img25.echo.cx/img25/6430/20fi.jpg
Column A : user name:login
Column B : A groupe on which user belongs

I must extract the informations of the first picture (ID, date, connection time etc of the user) in a new sheet by giving a specify groupe
For instance, if the groupe I input in the message box is "Profs", the program must find and extract all the users who belong to that groupe and copy/extract informations in a new sheet
any idea ? thanks :)

Post a new workbook with Profs in please.

http://kof54.free.fr/data.xls

2sheets in the workbook
profs is just an example^^ there are other groups

:(

Quote:

---

Originally Posted by atmakefka

:(

---

Patience! You will like it :thumb

Don't forget I do this for free in my own time.

thanks :)

Ok, try this http://flypicture.com/p.cfm?id=49437

BTW, what do you mean by

Quote:

---

profs is just an example^^ there are other groups

---

Thanks
I meant the different groups are in the second column of the second picture, the different groups are "profs", "etudiant DEUST 3eme annee", ...
anyway it's good, thanks for all