Need Code edit - 2

VBABEGINER

Well-known Member
Joined
Jun 15, 2011
Messages
1,130
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
 

Some videos you may like

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".

VBABEGINER

Well-known Member
Joined
Jun 15, 2011
Messages
1,130
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.
 

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,086
Office Version
  1. 2019
Platform
  1. Windows
try adding the Labels Caption property

Rich (BB code):
Me.LblUname.Caption

Dave
 

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,086
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

where and how..

where ever in your code you refer to the label & how shown in my post.

Dave
 

VBABEGINER

Well-known Member
Joined
Jun 15, 2011
Messages
1,130
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:

VBABEGINER

Well-known Member
Joined
Jun 15, 2011
Messages
1,130
Okk, Board members. im closing this query...as lot many confusion to me as well
 

Watch MrExcel Video

Forum statistics

Threads
1,108,974
Messages
5,525,990
Members
409,673
Latest member
Riseee

This Week's Hot Topics

Top