Insert Textbox values to seperate rows/columns
 

I am trying to insert textbox entries in the following manner but I a
having some problems with the insertion routine:

Col A B C
Row
1 txtTagName
2 Tag Description: txtTagDesc
3 On State: txtOnState
4 Off State: txtOffState
5 blank row
6 txtTagName
7 Tag Description: txtTagDesc
8 On State: txtOnState
9 Off State: txtOffState
10 blank row

then prompt for next set of data depending on value entered i
txtNumTags

Here's the code:

Private Sub cmdInsert_Click()
Dim wkBook As Workbook
Dim wkSheet As Worksheet
Dim x As Integer
Dim counter As Integer
Dim rowIndex As Integer

Application.ScreenUpdating = False

ActiveWorkbook.Sheets("Sixnet Digital Tags").Activate

range("A1").Select

Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True

x = txtNumTags.Value

rowIndex = 0

If optYes = True Then
For counter = 1 To x
ActiveCell.Offset(rowIndex, 0).Value = txtTagName.Value
Selection.Font.Bold = True

With ActiveCell.Offset(rowIndex + 1
0).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
ActiveCell.Offset(rowIndex + 1, 1) = "Tag Description:"
ActiveCell.Offset(rowIndex + 1, 2) = txtTagDesc.Value

With ActiveCell.Offset(rowIndex + 2
0).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
ActiveCell.Offset(rowIndex + 2, 1) = "On State:"
ActiveCell.Offset(rowIndex + 2, 2) = txtOnState.Value

With ActiveCell.Offset(rowIndex + 3
0).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
ActiveCell.Offset(rowIndex + 3, 1) = "Off State:"
ActiveCell.Offset(rowIndex + 3, 2) = txtOffState.Value

rowIndex = rowIndex + 5
Next 'counter
Else
ActiveCell.Value = "Not Applicable"
Unload Me
End If

Application.ScreenUpdating = True

Set wkBook = Nothing
Set wkSheet = Nothing
End Sub

Regards
M. Thompso

--
thompssmPosted from - http://www.officehelp.i

Insert Textbox values to seperate rows/columns
 

Maybe like this?

Private Sub cmdInsert_Click()
Dim x As Integer
Dim counter As Long
Dim rowIndex As Long

On Error GoTo ErrorHandler
Application.ScreenUpdating = False

With Sheets("Sixnet Digital Tags")
rowIndex = .Cells(Rows.Count, 1).End(xlUp).Row + 1

If optYes = True Then
x = txtNumTags.Value

For counter = 1 To x
With .Cells(rowIndex, 1)
.Value = txtTagName.Value
.Font.Bold = True
End With

With .Cells(rowIndex + 1, 1).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
.Cells(rowIndex + 1, 2).Value = "Tag Description:"
.Cells(rowIndex + 1, 3).Value = txtTagDesc.Value

With .Cells(rowIndex + 2, 1).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
.Cells(rowIndex + 2, 2).Value = "On State:"
.Cells(rowIndex + 2, 3).Value = txtOnState.Value

With .Cells(rowIndex + 3, 1).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
.Cells(rowIndex + 3, 2) = "Off State:"
.Cells(rowIndex + 3, 3) = txtOffState.Value

rowIndex = rowIndex + 5
Next counter
Else
.Cells(rowIndex, 1).Value = "Not Applicable"
End If
End With
Unload Me
ErrorHandler:
Application.ScreenUpdating = True
End Sub


Hope this helps
Rowan

thompssm wrote:
I am trying to insert textbox entries in the following manner but I am
having some problems with the insertion routine:

Col A B C
Row
1 txtTagName
2 Tag Description: txtTagDesc
3 On State: txtOnState
4 Off State: txtOffState
5 blank row
6 txtTagName
7 Tag Description: txtTagDesc
8 On State: txtOnState
9 Off State: txtOffState
10 blank row

then prompt for next set of data depending on value entered in
txtNumTags

Here's the code:

Private Sub cmdInsert_Click()
Dim wkBook As Workbook
Dim wkSheet As Worksheet
Dim x As Integer
Dim counter As Integer
Dim rowIndex As Integer

Application.ScreenUpdating = False

ActiveWorkbook.Sheets("Sixnet Digital Tags").Activate

range("A1").Select

Do
If IsEmpty(ActiveCell) = False Then
ActiveCell.Offset(1, 0).Select
End If
Loop Until IsEmpty(ActiveCell) = True

x = txtNumTags.Value

rowIndex = 0

If optYes = True Then
For counter = 1 To x
ActiveCell.Offset(rowIndex, 0).Value = txtTagName.Value
Selection.Font.Bold = True

With ActiveCell.Offset(rowIndex + 1,
0).Borders(xlEdgeBottom)
LineStyle = xlContinuous
Weight = xlThin
ColorIndex = xlAutomatic
End With
ActiveCell.Offset(rowIndex + 1, 1) = "Tag Description:"
ActiveCell.Offset(rowIndex + 1, 2) = txtTagDesc.Value

With ActiveCell.Offset(rowIndex + 2,
0).Borders(xlEdgeBottom)
LineStyle = xlContinuous
Weight = xlThin
ColorIndex = xlAutomatic
End With
ActiveCell.Offset(rowIndex + 2, 1) = "On State:"
ActiveCell.Offset(rowIndex + 2, 2) = txtOnState.Value

With ActiveCell.Offset(rowIndex + 3,
0).Borders(xlEdgeBottom)
LineStyle = xlContinuous
Weight = xlThin
ColorIndex = xlAutomatic
End With
ActiveCell.Offset(rowIndex + 3, 1) = "Off State:"
ActiveCell.Offset(rowIndex + 3, 2) = txtOffState.Value

rowIndex = rowIndex + 5
Next 'counter
Else
ActiveCell.Value = "Not Applicable"
Unload Me
End If

Application.ScreenUpdating = True

Set wkBook = Nothing
Set wkSheet = Nothing
End Sub

Regards
M. Thompson

Insert Textbox values to seperate rows/columns
 

Rowan,

Thanks! That worked much better than what I had. However, ther
remains one more issue. How do I get the form to allow me to enter th
next set of data (i.e., new tag information)?

Regards,
Shane Thompso

--
thompssmPosted from - http://www.officehelp.i

Insert Textbox values to seperate rows/columns
 

Hi Shane

What I would probably do is get rid of the number of tags textbox (I'm
assuming this is the number of tags that the user is going to enter).
Then remove the loop from the click event and having inserted the data
to the sheet clear all the textboxes and allow the user to enter new
data before hitting the insert button again. Then when finished the user
can hit an End/Cancel button to close the form. untested but something like:

Private Sub cmdInsert_Click()
Dim rowIndex As Long

On Error GoTo ErrorHandler
Application.ScreenUpdating = False

With Sheets("Sixnet Digital Tags")
rowIndex = .Cells(Rows.Count, 1).End(xlUp).Row + 1

If optYes = True Then
With .Cells(rowIndex, 1)
.Value = txtTagName.Value
.Font.Bold = True
End With

With .Cells(rowIndex + 1, 1).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
.Cells(rowIndex + 1, 2).Value = "Tag Description:"
.Cells(rowIndex + 1, 3).Value = txtTagDesc.Value

With .Cells(rowIndex + 2, 1).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
.Cells(rowIndex + 2, 2).Value = "On State:"
.Cells(rowIndex + 2, 3).Value = txtOnState.Value

With .Cells(rowIndex + 3, 1).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
.Cells(rowIndex + 3, 2) = "Off State:"
.Cells(rowIndex + 3, 3) = txtOffState.Value

Else
.Cells(rowIndex, 1).Value = "Not Applicable"
End If
End With

Me.txtTagName.Value = ""
Me.txtTagDesc.Value = ""
Me.txtOnState.Value = ""
Me.txtOffState.Value = ""
DoEvents

ErrorHandler:
Application.ScreenUpdating = True
End

Hope this helps
Rowan



thompssm wrote:
Rowan,

Thanks! That worked much better than what I had. However, there
remains one more issue. How do I get the form to allow me to enter the
next set of data (i.e., new tag information)?

Regards,
Shane Thompson