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


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