Need Code edit - 2

VBABEGINER

Well-known Member
Joined
Jun 15, 2011
Messages
1,232
Can any one tell me what goes wrong in this code..

LblUname = Label taken on userform

Code:
Dim x As Integer
Dim y As Integer
Dim NewSh As Worksheet


y = Sheets.Count


For x = 1 To y


If Sheets(x).Name = LblUname Then 


    NewSh = ActiveSheet.Name


    Set sht = Application.Workbooks("Timesheet.xlsm").Sheets(NewSh)
    newrow = sht.Cells(Rows.Count, 1).End(xlUp).Row + 1
    sht.Cells(newrow, 1) = CDate(Me.txtstartdate)
    Closed_date = DateTime.Now
    sht.Cells(newrow, 2) = CDate(Closed_date)
    '---------------------------------------------
    sht.Cells(newrow, 3) = Me.cmbActivity   'Col C
    sht.Cells(newrow, 4) = Me.ComboBox1     'sub Type Col D
    sht.Cells(newrow, 5) = Me.TxtCaseID     'Col E
    sht.Cells(newrow, 6) = Me.TxtEETime     'Col F
    '---------------------------------------------
    sht.Cells(newrow, 7) = Me.cmbClientName  'Col G
    sht.Cells(newrow, 8) = Me.cmbTaskName    'Col H
    sht.Cells(newrow, 9) = Me.cmbTaskStatus  'Col I
    sht.Cells(newrow, 10) = Me.txtcomm       'Col K
    sht.Cells(newrow, 11) = Me.LblUname      'Col L
    Workbooks("Timesheet.xlsm").Save
Else
    Dim ShName As String
    Worksheets("Sheet1").Visible = True
    Sheets("Sheet1").Select
    With ActiveSheet
    ShName = .Name & "Copy"
    .Copy After:=Sheets(Worksheets.Count)
    End With
    'Sheets(Worksheets.Count).Name = ShName
    ActiveWorkbook.Worksheets(ShName).Name = LblUname
    NewSh = ActiveSheet.Name


    Set sht = Application.Workbooks("Timesheet.xlsm").Sheets(NewSh)
    newrow = sht.Cells(Rows.Count, 1).End(xlUp).Row + 1
    sht.Cells(newrow, 1) = CDate(Me.txtstartdate)
    Closed_date = DateTime.Now
    sht.Cells(newrow, 2) = CDate(Closed_date)
    '---------------------------------------------
    sht.Cells(newrow, 3) = Me.cmbActivity   'Col C
    sht.Cells(newrow, 4) = Me.ComboBox1     'sub Type Col D
    sht.Cells(newrow, 5) = Me.TxtCaseID     'Col E
    sht.Cells(newrow, 6) = Me.TxtEETime     'Col F
    '---------------------------------------------
    sht.Cells(newrow, 7) = Me.cmbClientName  'Col G
    sht.Cells(newrow, 8) = Me.cmbTaskName    'Col H
    sht.Cells(newrow, 9) = Me.cmbTaskStatus  'Col I
    sht.Cells(newrow, 10) = Me.txtcomm       'Col K
    sht.Cells(newrow, 11) = Me.LblUname      'Col L
    Workbooks("Timesheet.xlsm").Save
    Worksheets("Sheet1").Visible = False
    Exit Sub
End If
Next x
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
LblUname = Label taken on userform

Code:
[COLOR=#ff0000]If Sheets(x).Name = LblUname Then[/COLOR]
In the Red color part, I want to check whether any sheets are available or not with user name which is appearing on Label.
if it is there, then no need to create copy of "Sheet1". It will paste the data with existing sheet.
Else,
create a copy of "Sheet1" worksheet and name that worksheet with user name.
 
Upvote 0
try adding the Labels Caption property

Rich (BB code):
Me.LblUname.Caption

Dave
 
Upvote 0
This is some modified code..
Pls sugeest..

Code:
Function WorksheetExists(WSName As String) As Boolean
On Error Resume Next
WorksheetExists = Worksheets(WSName).Name = WSName
End Function

Code:
Dim x As Integer
Dim y As Integer
Dim NewSh As Worksheet
Dim p As Worksheet


y = Sheets.Count


For x = 1 To y


    If Not WorksheetExists(p) Then
        Exit Sub
    Else
        If Sheets(x).Name = LblUname Then
        NewSh = ActiveSheet.Name
        Set sht = Application.Workbooks("Timesheet.xlsm").Sheets(NewSh)
        newrow = sht.Cells(Rows.Count, 1).End(xlUp).Row + 1
        sht.Cells(newrow, 1) = CDate(Me.txtstartdate)
        Closed_date = DateTime.Now
        sht.Cells(newrow, 2) = CDate(Closed_date)
        '---------------------------------------------
        sht.Cells(newrow, 3) = Me.cmbActivity   'Col C
        sht.Cells(newrow, 4) = Me.ComboBox1     'sub Type Col D
        sht.Cells(newrow, 5) = Me.TxtCaseID     'Col E
        sht.Cells(newrow, 6) = Me.TxtEETime     'Col F
        '---------------------------------------------
        sht.Cells(newrow, 7) = Me.cmbClientName  'Col G
        sht.Cells(newrow, 8) = Me.cmbTaskName    'Col H
        sht.Cells(newrow, 9) = Me.cmbTaskStatus  'Col I
        sht.Cells(newrow, 10) = Me.txtcomm       'Col K
        sht.Cells(newrow, 11) = Me.LblUname      'Col L
        Workbooks("Timesheet.xlsm").Save
        
        Else
        
        Dim ShName As String
        Worksheets("Sheet1").Visible = True
        Sheets("Sheet1").Select
        With ActiveSheet
        ShName = .Name & "Copy"
        .Copy After:=Sheets(Worksheets.Count)
        End With
        'Sheets(Worksheets.Count).Name = ShName
        ActiveWorkbook.Worksheets(ShName).Name = LblUname
        NewSh = ActiveSheet.Name
    
        Set sht = Application.Workbooks("Timesheet.xlsm").Sheets(NewSh)
        newrow = sht.Cells(Rows.Count, 1).End(xlUp).Row + 1
        sht.Cells(newrow, 1) = CDate(Me.txtstartdate)
        Closed_date = DateTime.Now
        sht.Cells(newrow, 2) = CDate(Closed_date)
        '---------------------------------------------
        sht.Cells(newrow, 3) = Me.cmbActivity   'Col C
        sht.Cells(newrow, 4) = Me.ComboBox1     'sub Type Col D
        sht.Cells(newrow, 5) = Me.TxtCaseID     'Col E
        sht.Cells(newrow, 6) = Me.TxtEETime     'Col F
        '---------------------------------------------
        sht.Cells(newrow, 7) = Me.cmbClientName  'Col G
        sht.Cells(newrow, 8) = Me.cmbTaskName    'Col H
        sht.Cells(newrow, 9) = Me.cmbTaskStatus  'Col I
        sht.Cells(newrow, 10) = Me.txtcomm       'Col K
        sht.Cells(newrow, 11) = Me.LblUname      'Col L
        Workbooks("Timesheet.xlsm").Save
        Worksheets("Sheet1").Visible = False
        Exit Function
        End If
    End If
Next x
 
Last edited:
Upvote 0

Forum statistics

Threads
1,214,587
Messages
6,120,406
Members
448,958
Latest member
Hat4Life

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top