I have a worksheet with 3 sets of textboxes and checkboxes to capture text information. A command button allows the user to add a 4th, 5th, etc "series" of textboxes and checkboxes if they need to report more information.
The code below first copies the rows where the first set of objects are and inserts them at rangename AddExpEnd. Then the series of objects are selected, copied and pasted to the new location.
Since the copied objects will have text in textboxes and the checkboxes will have been checked, I need to loop through the objects and set the checkbox value=false and the value of the textboxes="".
The code below runs properly in Excel 2003 but a recent upgrade to Office 2010 has raised the incompatibility. I now get a type mismatch error at or after
However, VBA won't run in break mode to aid in debugging.
The code does the copy and paste of rows and objects but does not execute the code for "clearing" the values (see bolded section)
Sub AddExpense()
Dim ExpTblOrigin As Range
Dim ExpInsTableInd As Range
Dim ExpNewTblOrigin As Range
Dim LastItemNum As Integer
Dim SheetInd As Integer
Dim appState As CAppState
Dim ws As Worksheet
Dim shp As Shape
Dim newHeight As Single
Dim oe As OLEObject
Dim shpRng As Object 'DrawingObjects
Dim i As Long
Dim row As Long
Dim lastRow As Long
Dim category As String
Set ws = Sheets("Financial")
' Set the Sheet Index of the Financial worksheet
SheetInd = ws.Index
'Sets the range ExpTblOrigin to the cell containing the string "AddExpBegin"
Set ExpTblOrigin = ws.Range("AddExpStart")
' Sets the index(ExpInsTableInd) for where new table is to be inserted
Set ExpInsTableInd = ws.Range("AddExpEnd")
LastItemNum = Left(ws.Cells(ExpInsTableInd.row, 3).End(xlUp).Value, 1)
With ws
'Copy first table
With .Range(.Cells(ExpTblOrigin.row + 1, ExpTblOrigin.Column), .Cells(ExpTblOrigin.row + 17, ExpTblOrigin.Column + 10)).EntireRow
.Copy
newHeight = .Height
End With
'Insert the copied table at the InsTableInd row and shift cells down
.Range(.Cells(ExpInsTableInd.row, 3), .Cells(ExpInsTableInd.row, 3)).EntireRow.Insert Shift:=xlDown
End With
'Sets the index of the table that was just added (Country of Origin cell)
Set ExpNewTblOrigin = ws.Cells(ExpInsTableInd.row - 17, ExpInsTableInd.Column)
'insert a pagebreak at top of new page
ws.Rows(ExpNewTblOrigin.row).PageBreak = xlPageBreakManual
'Copy TextBox 1,2,3 & 4 and CheckBox 1 & 2 from the first series of table
ActiveSheet.Shapes.Range(Array("TextBox1", "TextBox2", "TextBox3", "TextBox4", "CheckBox3", "CheckBox2")).Select
Selection.Copy
'Paste copied boxes into new table
ws.Cells(ExpNewTblOrigin.row, 3).Activate
ws.Paste
[B]Set shpRng = Selection[/B]
[B] With ws
For Each oe In shpRng
Select Case oe.progID
Case "Forms.CheckBox.1"
oe.object.Value = False
Case "Forms.TextBox.1"
oe.object.Value = ""
End Select
Next oe
End With
[/B]
Set shp = ws.Shapes("btnAddExpense")
shp.Top = shp.Top + newHeight
'Updates the number of the expense item
ws.Cells(ExpNewTblOrigin.row, ExpNewTblOrigin.Column).Value = (LastItemNum + 1) & ")"
ws.Cells(ExpNewTblOrigin.row, ExpNewTblOrigin.Column).Activate
ExitSub:
'Clear clipboard
Application.CutCopyMode = False
End Sub
Display More