Need Code edit - 2

VBABEGINER

Well-known Member
Joined
Jun 15, 2011
Messages
1,284
Office Version
  1. 365
Platform
  1. Windows
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

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
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
Okk, Board members. im closing this query...as lot many confusion to me as well
 
Upvote 0

Forum statistics

Threads
1,224,827
Messages
6,181,197
Members
453,021
Latest member
pingpong7117

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