Results 1 to 2 of 2

Thread: Data entry vba with selecting range without activating sheet actual implementation

  1. #1

    Data entry vba with selecting range without activating sheet actual implementation



    Register for a FREE account, and/
    or Log in to avoid these ads!

    I have created a userform named calltracker, that will transpose values into the into next row, however
    i would like to make this userform working without activating the sheet that will hold values,
    the userform calltracker has navigation button that goes to each cell row. Can someone help me to accomplish
    this, this is my code. i have read its possible to select ranges without activating. i have opted to refrain from
    using a data form. Pls help me
    Option Explicit


    Public currentRow As Long
    Public lastRow As Long
    Public sheetName As String
    Public fPath As String



    Private Sub cmbLast_Click()

    Sheets("calltracker").Activate

    lastRow = Sheets("calltracker").Range("a" & Rows.Count).End(xlUp).Row
    'lastRow = callt.Range("a" & Rows.Count).End(xlUp).Row
    currentRow = currentRow + 1
    If currentRow = lastRow + 1 Then
    MsgBox ("You have reached the last row of data!")
    currentRow = lastRow
    End If
    Calltracker.TextBox6.Text = Cells(currentRow, 2).Text
    Calltracker.TextBox1.Text = Cells(currentRow, 3).Text
    Calltracker.TextBox8.Text = Cells(currentRow, 4).Text
    Calltracker.TextBox2.Text = Cells(currentRow, 5).Text
    Calltracker.TextBox3.Text = Cells(currentRow, 6).Text
    Calltracker.TextBox7.Text = Cells(currentRow, 7).Text
    Calltracker.TextBox4.Text = Cells(currentRow, 8).Text
    Calltracker.TextBox5.Text = Cells(currentRow, 9).Text
    Calltracker.ComboBox1.Text = Cells(currentRow, 10).Text
    Calltracker.Label8.Caption = Cells(currentRow, 1).Text
    'Calltracker.TextBox6.Text = ActiveCell.Offset(0, 1).Value
    'txtLname.Text = Cells(currentRow, 2).Text

    End Sub



    Private Sub cmnbFirst_Click()
    'Dim sht As Worksheet
    'Dim FirstCl As Range
    Sheets("calltracker").Activate


    currentRow = currentRow - 1
    If currentRow > 1 Then
    Calltracker.TextBox6.Text = Cells(currentRow, 2).Text
    Calltracker.TextBox1.Text = Cells(currentRow, 3).Text
    Calltracker.TextBox8.Text = Cells(currentRow, 4).Text
    Calltracker.TextBox2.Text = Cells(currentRow, 5).Text
    Calltracker.TextBox3.Text = Cells(currentRow, 6).Text
    Calltracker.TextBox7.Text = Cells(currentRow, 7).Text
    Calltracker.TextBox4.Text = Cells(currentRow, 8).Text
    Calltracker.TextBox5.Text = Cells(currentRow, 9).Text
    Calltracker.ComboBox1.Text = Cells(currentRow, 10).Text
    Calltracker.Label8.Caption = Cells(currentRow, 1).Text
    'Calltracker.ComboBox1.Text = Cells(currentRow, 1).Text


    'txtLname.Text = Cells(currentRow, 2).Text
    ElseIf currentRow = 1 Then
    MsgBox "Now you are in the header row!"
    currentRow = currentRow + 1
    End If


    End Sub



    Private Sub CommandButton1_Click()
    Dim sht As Worksheet
    Dim i As Integer
    'position cursor in the correct cell A2.
    Sheets("calltracker").Select
    Range("A2").Select
    i = 1 'set as the first ID

    'validate first three controls have been entered...
    If TextBox1.Text = Empty Then 'Firstname
    MsgBox "Company Name.", vbExclamation
    Me.TextBox1.SetFocus 'position cursor to try again
    Exit Sub 'terminate here - why continue?
    End If

    If TextBox8.Text = Empty Then 'Surname
    MsgBox "contact person.", vbExclamation
    Me.TextBox8.SetFocus 'position cursor to try again
    Exit Sub 'terminate here - why continue?

    End If
    If TextBox2.Text = Empty Then 'Surname
    MsgBox "Telephone Number Fax.", vbExclamation
    Me.TextBox2.SetFocus 'position cursor to try again
    Exit Sub 'terminate here - why continue?
    End If

    If TextBox3.Text = Empty Then 'Department
    MsgBox "Mobile Number.", vbExclamation
    Me.TextBox3.SetFocus 'position cursor to try again
    Exit Sub 'terminate here - why continue?
    End If

    If TextBox7.Text = Empty Then 'Department
    MsgBox "Address.", vbExclamation
    Me.TextBox7.SetFocus 'position cursor to try again
    Exit Sub 'terminate here - why continue?
    End If

    If TextBox4.Text = Empty Then 'Department
    MsgBox " email Address.", vbExclamation
    Me.TextBox4.SetFocus 'position cursor to try again
    Exit Sub 'terminate here - why continue?
    End If


    If TextBox5.Text = Empty Then 'Department
    MsgBox "Concern.", vbExclamation
    Me.TextBox5.SetFocus 'position cursor to try again
    Exit Sub 'terminate here - why continue?
    End If


    'if all the above are false (OK) then carry on.
    'check to see the next available blank row start at cell A2...
    Do Until ActiveCell.Value = Empty
    ActiveCell.Offset(1, 0).Select 'move down 1 row
    i = i + 1 'keep a count of the ID for later use
    Loop

    'Populate the new data values into the 'Data' worksheet.
    ActiveCell.Value = i 'Next ID number
    ActiveCell.Offset(0, 1).Value = Me.TextBox6.Text 'time
    ActiveCell.Offset(0, 2).Value = Me.TextBox1.Text 'set company name b
    ActiveCell.Offset(0, 3).Value = Me.TextBox8.Text 'set contact person c
    ActiveCell.Offset(0, 4).Value = Me.TextBox2.Text 'set telephone/fax d
    ActiveCell.Offset(0, 5).Value = Me.TextBox3.Text 'mobile number e
    ActiveCell.Offset(0, 6).Value = Me.TextBox7.Text 'address f
    ActiveCell.Offset(0, 7).Value = Me.TextBox4.Text 'email g
    ActiveCell.Offset(0, 8).Value = Replace(TextBox5.Text, Chr(10), " ") 'concern h
    ActiveCell.Offset(0, 9).Value = Me.ComboBox1.SelText

    'Replace(TextBox5.Text, vbCr, "")
    'Is this person the manager?
    ' If Me.chkManager.Value = True Then 'yes
    ' ActiveCell.Offset(0, 4).Value = "Yes" 'Col E
    ' Else
    ' ActiveCell.Offset(0, 4).Value = "No" 'Col E
    ' End If

    'Clear down the values ready for the next record entry...
    Me.TextBox1.Text = Empty
    Me.TextBox2.Text = Empty
    Me.TextBox3.Text = Empty
    Me.TextBox7.Text = Empty
    Me.TextBox4.Text = Empty
    Me.TextBox5.Text = Empty

    Me.TextBox1.SetFocus 'positions the cursor for next record entry

    End Sub


    Private Sub CommandButton2_Click()
    ' Dim cControl As Control
    '
    ' For Each cControl In Me.Controls
    ' If cControl.Name Like "Text*" Then cControl = vbNullString
    ' Next
    TextBox1.Value = ""
    TextBox2.Value = ""
    TextBox3.Value = ""
    TextBox4.Value = ""
    TextBox5.Value = ""
    TextBox7.Value = ""
    TextBox8.Value = ""

    End Sub



    Private Sub UserForm_Initialize()
    TextBox6.Value = Format(Date, "dd/mmm/yyyy")
    ComboBox1.List = Array("supplier_company", "supplier_personal", "buyer_personal", "buyer_company")

    currentRow = 9


    End Sub
    Attached Files Attached Files

  2. #2
    Super Moderator p45cal's Avatar
    Join Date
    Dec 2012
    Posts
    1,480
    Articles
    0
    Excel Version
    365
    try:
    Code:
    Private Sub CommandButton1_Click()
    Dim sht As Worksheet
    Dim i As Integer, Destn As Range
    
    'validate first three controls have been entered...
    If TextBox1.Text = Empty Then  'Firstname
      MsgBox "Company Name.", vbExclamation
      Me.TextBox1.SetFocus  'position cursor to try again
      Exit Sub  'terminate here - why continue?
    End If
    
    If TextBox8.Text = Empty Then  'Surname
      MsgBox "contact person.", vbExclamation
      Me.TextBox8.SetFocus  'position cursor to try again
      Exit Sub  'terminate here - why continue?
    
    End If
    If TextBox2.Text = Empty Then  'Surname
      MsgBox "Telephone Number Fax.", vbExclamation
      Me.TextBox2.SetFocus  'position cursor to try again
      Exit Sub  'terminate here - why continue?
    End If
    
    If TextBox3.Text = Empty Then  'Department
      MsgBox "Mobile Number.", vbExclamation
      Me.TextBox3.SetFocus  'position cursor to try again
      Exit Sub  'terminate here - why continue?
    End If
    
    If TextBox7.Text = Empty Then  'Department
      MsgBox "Address.", vbExclamation
      Me.TextBox7.SetFocus  'position cursor to try again
      Exit Sub  'terminate here - why continue?
    End If
    
    If TextBox4.Text = Empty Then  'Department
      MsgBox " email Address.", vbExclamation
      Me.TextBox4.SetFocus  'position cursor to try again
      Exit Sub  'terminate here - why continue?
    End If
    
    If TextBox5.Text = Empty Then  'Department
      MsgBox "Concern.", vbExclamation
      Me.TextBox5.SetFocus  'position cursor to try again
      Exit Sub  'terminate here - why continue?
    End If
    
    Set Destn = Sheets("calltracker").Range("A2").End(xlDown).Offset(1)
    'i = Destn.Row - 1
    i = Sheets("calltracker").Range("A2", Destn).Rows.Count 'more complicated than the above line but will cope better if your data doesn't start at row 2.
    'if all the above are false (OK) then carry on.
    'Populate the new data values into the 'Data' worksheet.
    Destn.Resize(, 10).Value = Array(i, TextBox6.Text, TextBox1.Text, TextBox8.Text, TextBox2.Text, TextBox3.Text, TextBox7.Text, TextBox4.Text, Replace(TextBox5.Text, Chr(10), " "), ComboBox1.Text)
    'Replace(TextBox5.Text, vbCr, "")
    'Is this person the manager?
    ' If Me.chkManager.Value = True Then 'yes
    '  ActiveCell.Offset(0, 4).Value = "Yes" 'Col E
    ' Else
    ' ActiveCell.Offset(0, 4).Value = "No" 'Col E
    ' End If
    
    'Clear down the values ready for the next record entry...
    Me.TextBox1.Text = Empty
    Me.TextBox2.Text = Empty
    Me.TextBox3.Text = Empty
    Me.TextBox7.Text = Empty
    Me.TextBox4.Text = Empty
    Me.TextBox5.Text = Empty
    Me.TextBox1.SetFocus  'positions the cursor for next record entry
    End Sub

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •