Need code repair..

VBABEGINER

Well-known Member
Joined
Jun 15, 2011
Messages
1,232
In Module-
Code:
Function SheetExists(sheetName As String, Optional Wb As Workbook) As Boolean
    If Wb Is Nothing Then Set Wb = ThisWorkbook
    On Error Resume Next
    SheetExists = (LCase(Wb.Sheets(sheetName).Name) = LCase(sheetName))
    On Error GoTo 0
End Function

------------------------

I have 2 condition in below code,
No. 1 - If user name sheet is available then perform the code
and
No. 2 - If user name sheet is not available then create new sheet name "application.user" and then perform the code

Problem occurred at - No. 1. User name sheet is available but data is not going in user name sheet.

Can any one please help me understand where is the problem..


In User Form-
Code:
Private Sub btnsubmit_Click()
Dim sht As Worksheet, NewSh As String
Dim Closed_date As Date, newrow As Long


Application.ScreenUpdating = False


ThisWorkbook.Unprotect "WTW"


If cmbActivity.ListIndex = -1 Then
    MsgBox ("Select Activity Type")
    ThisWorkbook.Protect "WTW"
    Exit Sub
Else
If cmbActivity.Enabled = True Then
    If ComboBox1.ListIndex = -1 Then
        If cmbActivity.Value = "Core" Then
            MsgBox ("Select sub Core Activity")
        End If
        If cmbActivity.Value = "Non-Core" Then
            MsgBox ("Select sub Non - Core Activity")
        End If
    Else


'Start Non-Core here..
If cmbActivity.Value = "Non-Core" Then


If SheetExists(Me.LblUname.Caption) Then
    'Sheets(Me.LblUname.Caption).Select
    Sheets(Application.UserName).Select
    
    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.Add after:=Sheets(Sheets.Count)
    With Sheets(Sheets.Count)
       .Visible = True
       .Name = Application.UserName
    End With
    
    NewSh = ActiveSheet.Name
    
    Sheets("Sheet1").Visible = True
    Sheets("Sheet1").Select
    Rows("1:1").Copy
    Sheets(NewSh).Activate
    Range("A1").PasteSpecial xlPasteValues
    Range("A1").PasteSpecial xlPasteFormats
        
    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
    Worksheets(NewSh).Visible = False
End If
.
.
Other closing code further..
 

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
Sorry for early bump...but someone please look at this too...really helpful to solve entire problem..
 
Upvote 0
.
First thing would be to edit your "IF"; "ELSE"; "ELSEIF"; "END IF" statements.

For every IF .. after the code that follows, there must be an END IF.

Where you have an :

Code:
If .... Then

'some code

Else

'some code

If

It may need to be :

Code:
If .... Then

'some code

ElseIf ... Then

'some code

End If


You have several instances where there are several IFs then another IF then another IF ....
You can 'stack' / 'tier' a number of IFs like that but they must end with an END IF somewhere.

Example :

Code:
Sub mysub()

If ... Then
    'some code
        If .. Then
            'some code
        End If
    'some code
End If


End Sub

Notice how the IFs and END IFs line up for each section ?
 
Last edited:
Upvote 0
That's really nice explanation. But I will be more and much happy if i get code rectification. That's the only stuck else i can submit this project to team.

Can you please fix..


.
First thing would be to edit your "IF"; "ELSE"; "ELSEIF"; "END IF" statements.

For every IF .. after the code that follows, there must be an END IF.

Where you have an :

Code:
If .... Then

'some code

Else

'some code

If

It may need to be :

Code:
If .... Then

'some code

ElseIf ... Then

'some code

End If


You have several instances where there are several IFs then another IF then another IF ....
You can 'stack' / 'tier' a number of IFs like that but they must end with an END IF somewhere.

Example :

Code:
Sub mysub()

If ... Then
    'some code
        If .. Then
            'some code
        End If
    'some code
End If


End Sub

Notice how the IFs and END IFs line up for each section ?
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,251
Members
448,556
Latest member
peterhess2002

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