VBA to create formated sign-in sheet from database

[Rog84]

Good day everyone,

I hope you will be able to give me a hand with this, basically I have an excel workbook where the first tab is a list of shifts associated with the employee name and the date sorted in order of shift and date.

Then I've created a 2nd tab called "Sign-in Creator", where you can enter the date needed (Usually we prepare this for the next day) then you click on the button where I would like to associate a VBA to create a new worksheet named with the date and formats it to a sign-in sheet and add the proper number of lines needed depending on how many agents or working.

I've also added a tab as an example to give an idea of what I would like to get as a result.

Thanks,

 

[Rog84]

Here is the document : Sign-in sheet.xlsx - Google Drive

Thanks,

Good day everyone,

I hope you will be able to give me a hand with this, basically I have an excel workbook where the first tab is a list of shifts associated with the employee name and the date sorted in order of shift and date.

Then I've created a 2nd tab called "Sign-in Creator", where you can enter the date needed (Usually we prepare this for the next day) then you click on the button where I would like to associate a VBA to create a new worksheet named with the date and formats it to a sign-in sheet and add the proper number of lines needed depending on how many agents or working.

I've also added a tab as an example to give an idea of what I would like to get as a result.

Thanks,

 

[Rog84]

 

[Fluff]

Hia
I've uploaded a modified file here
Sign-in sheet.xls - Google Drive
I've turned one of your example sheets into a template for the macro to use. For reference the code is

Sub CreateSht()

    Dim Rng As Range
    Dim Dte As String
    Dim Rw As Integer
    Dim UsdRws As Integer
    Dim Agnts As Integer

Application.ScreenUpdating = False

    UsdRws = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row
    Dte = Format(Sheets("Sign-in creator").Range("B2"), "dd MMM YYYY")
    
    On Error Resume Next
    Sheets(Dte).Activate
    On Error GoTo 0
    If ActiveSheet.Name = Dte Then
        MsgBox "Sheet " & Dte & "already exists"
        Exit Sub
    End If
    
    Sheets("Template").Copy after:=Sheets(Sheets.Count)
    ActiveSheet.Name = Dte
    
    Agnts = WorksheetFunction.CountIf(Sheets("Data").Columns(1), Dte)
    
    Rw = 3
    With Sheets(Dte)
        .Range("B1").Value = Dte
        .Range("A4").Resize(Agnts - 2).EntireRow.Insert
        For Each Rng In Sheets("Data").Range("A2:A" & UsdRws)
            If Format(Rng.Value, "dd MMM YYYY") = Dte Then
                .Range("A" & Rw).Value = Rng.Offset(, 2).Value
                .Range("B" & Rw).Value = Rng.Offset(, 1).Value
                Rw = Rw + 1
            End If
        Next Rng
        .Range("M3").Resize(Agnts).Formula = "=[COLOR=#0000ff]A1&B1[/COLOR]"
    End With
    
Application.ScreenUpdating = True
    
End Sub

You'll need to convert this file into an .xlsm file.
Also it looked like you had a formula in column M, if so, modify the code in blue (above) or else delete that line of code.
HTH

 

[Rog84]

Thank you so much Fluff for taking the time of doing this !

I'm having a little issue with the macro though, even after converting the file to .xlsm, I always get the following error message..

"Run-time error '1004':

Application-defined or object-defined error"

The new is created anyways, but the rows doesn't match the number of people working that day and the cells for the names are also blank (no names), I'm not sure if it's related, but I've noticed the date in cell B4 says for example "25 juil 2017" instead of "25 Jul 2017", maybe it's related ?

Thank you so much again!

Rog

Hia
I've uploaded a modified file here
Sign-in sheet.xls - Google Drive
I've turned one of your example sheets into a template for the macro to use. For reference the code is

Sub CreateSht()

    Dim Rng As Range
    Dim Dte As String
    Dim Rw As Integer
    Dim UsdRws As Integer
    Dim Agnts As Integer

Application.ScreenUpdating = False

    UsdRws = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row
    Dte = Format(Sheets("Sign-in creator").Range("B2"), "dd MMM YYYY")
    
    On Error Resume Next
    Sheets(Dte).Activate
    On Error GoTo 0
    If ActiveSheet.Name = Dte Then
        MsgBox "Sheet " & Dte & "already exists"
        Exit Sub
    End If
    
    Sheets("Template").Copy after:=Sheets(Sheets.Count)
    ActiveSheet.Name = Dte
    
    Agnts = WorksheetFunction.CountIf(Sheets("Data").Columns(1), Dte)
    
    Rw = 3
    With Sheets(Dte)
        .Range("B1").Value = Dte
        .Range("A4").Resize(Agnts - 2).EntireRow.Insert
        For Each Rng In Sheets("Data").Range("A2:A" & UsdRws)
            If Format(Rng.Value, "dd MMM YYYY") = Dte Then
                .Range("A" & Rw).Value = Rng.Offset(, 2).Value
                .Range("B" & Rw).Value = Rng.Offset(, 1).Value
                Rw = Rw + 1
            End If
        Next Rng
        .Range("M3").Resize(Agnts).Formula = "=[COLOR=#0000ff]A1&B1[/COLOR]"
    End With
    
Application.ScreenUpdating = True
    
End Sub

You'll need to convert this file into an .xlsm file.
Also it looked like you had a formula in column M, if so, modify the code in blue (above) or else delete that line of code.
HTH

 

[Rog84]

Nevermind, the problem was my language setting !

It works like a charm, thank you so much Fluff !

 

[Fluff]

Glad to help & thanks for the feedback