Please send me correct formula, Sr. No not generated properly for selecting activated sheet

[Aravindakumar]

>>> use code - tags <<<

Private Sub btnAdd_Click()
Dim I As Long, j As Long
Dim A As Integer
Set rs = Worksheets("RAW")

  'Find the first empty row
  lRow = rs.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
  rs.Cells(lRow, 1).Value = Me.cmbSurname.Value
  lRow = rs.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row
  rs.Cells(lRow, 2).Value = Me.cmbName.Value
  lRow = rs.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Row
  rs.Cells(lRow, 2).Value = Me.cmbNLM.Value
 

    Dim xRg As Range
    On Error Resume Next
    Worksheets.Add Sheets(1)
     For I = 2 To Sheets.Count
        Set xRg = Sheets(1).UsedRange
        If I > 2 Then
            Set xRg = Sheets(1).Cells(xRg.Rows.Count + 1, 1)
        End If
        Sheets(I).Activate
        ActiveSheet.UsedRange.Copy xRg
    Next
         
  TargetSheet = cmbWard.Value
  If TargetSheet = "" Then
  Exit Sub
  End If
  Worksheets(TargetSheet).Activate
  ActiveSheet.Cells(Lastrow + 1, 1).Value = iSerial
  Lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
  ActiveSheet.Cells(Lastrow + 1, 2).Value = Me.cmbWard.Value
  ActiveSheet.Cells(Lastrow + 1, 3).Value = Me.txtBooth.Value
  ActiveSheet.Cells(Lastrow + 1, 4).Value = UCase(txtVSN)
  ActiveSheet.Cells(Lastrow + 1, 5).Value = UCase(Me.txtVLPN)
  ActiveSheet.Cells(Lastrow + 1, 6).Value = StrConv(LTrim(cmbSurname & " " & cmbName.Value), vbUpperCase)
  ActiveSheet.Cells(Lastrow + 1, 7).Value = UCase(Me.txtEPIC)
  ActiveSheet.Cells(Lastrow + 1, 8).Value = UCase(Me.txtDoorno)
  ActiveSheet.Cells(Lastrow + 1, 9).Value = UCase(Me.cmbNLM)
  If Len(txtContact.Value) = 10 Then
  ActiveSheet.Cells(Lastrow + 1, 10).Value = Me.txtContact.Value
  End If
  If Len(txtContact.Value) = 7 Then
  ActiveSheet.Cells(Lastrow + 1, 10).Value = "0891 - " + Me.txtContact.Value
  End If
  ActiveSheet.Cells(Lastrow + 1, 11).Value = UCase(Me.cmbRemarks1.Value)
  ActiveSheet.Cells(Lastrow + 1, 12).Value = UCase(Me.cmbRemarks2.Value)
  With Worksheets(TargetSheet).UsedRange.Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
  End With
 
 
 
 
ActiveSheet.Visible = True
ActiveCell.Offset(1, 0).Select
ActiveWorkbook.Save
 
   
 
  'Clear down the values ready for the next record entry...
  Me.cmbSurname.Value = Empty
  Me.cmbName.Value = Empty
  Me.txtBooth.Value = Empty
  Me.txtDoorno.Text = Empty
  Me.cmbNLM.Value = Empty
  Me.txtEPIC.Text = Empty
  Me.txtContact.Text = Empty
  Me.txtVLPN.Value = Empty
  Me.cmbWard.Value = Empty
  Me.txtVSN.Value = Empty
  Me.cmbRemarks1.Value = Empty
  Me.cmbRemarks2.Value = Empty
   
  ActiveSheet.Visible = True
  ActiveCell.Select
  ActiveWorkbook.Save
 
 
  Unload Me
  UserForm.Show
 
End Sub


Private Sub UserForm_Initialize()
'fill cmbWard
Me.cmbWard.AddItem "14"
Me.cmbWard.AddItem "24"
Me.cmbWard.AddItem "25"
Me.cmbWard.AddItem "26"
Me.cmbWard.AddItem "42"
Me.cmbWard.AddItem "43"
Me.cmbWard.AddItem "44"
Me.cmbWard.AddItem "45"
Me.cmbWard.AddItem "46"
Me.cmbWard.AddItem "47"
Me.cmbWard.AddItem "48"
Me.cmbWard.AddItem "49"
Me.cmbWard.AddItem "50"
Me.cmbWard.AddItem "51"
Me.cmbWard.AddItem "53"
Me.cmbWard.AddItem "54"
Me.cmbWard.AddItem "55"

'fill cmbRemark1
Me.cmbRemarks1.AddItem "Available"
Me.cmbRemarks1.AddItem "Not Available"
Me.cmbRemarks1.AddItem "Other"

'fill cmbRemark2
Me.cmbRemarks2.AddItem "New"
Me.cmbRemarks2.AddItem "Shifted"
Me.cmbRemarks2.AddItem "Found"
Me.cmbRemarks2.AddItem "Not Found"
Me.cmbRemarks2.AddItem "Death"

'fill cmbSurname
With RAW
    Me.cmbSurname.List = .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row).Value
    Me.cmbName.List = .Range("B2:B" & .Range("B" & Rows.Count).End(xlUp).Row).Value
    Me.cmbNLM.List = .Range("C2:C" & .Range("C" & Rows.Count).End(xlUp).Row).Value
    End With
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  If CloseMode = VbControlMenu Then

       Cancel = True
       MsgBox "You have to exit using the close button on the form!", vbCritical, "Error"
    End If

End Sub

 

[Marc L]

As your thread title has no sense then your guessing challenge has no place on any Excel forum​

so restart from here :​

Site Rules - New Users - Please Read

Hi all, Welcome to the Chandoo.org Forums. Posting Rules & Etiquette The Chandoo.org Forums is a collaborative and happy place to learn and expand your Excel knowledge. The Chandoo.org Forums consist of several Sub-Forums based on the type of question/area of Excel you are interested in...

chandoo.org

​

To debug your code you must remove the useless codeline On Error Resume Next …​

​