Data entry vba with selecting range without activating sheet actual implementation

12345helper

New member
Joined
Sep 29, 2014
Messages
1
Reaction score
0
Points
0
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
 

Attachments

  • help.xlsm
    42 KB · Views: 32
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
 
Back
Top