Solved: questionnaire

[Ann]

Hi,
I have a problem with the output of a questionnaire.
I get the message 'Run time error '1004': Application-defined or object-defined error'.

The questionnaire is in one worksheet and I want VBA to print the output from this to another worksheet. But VBA doesn't allow me to do that.

My code is quite long, and I have posted the code in the bottom. The problem seems to be in this fragment:

[vba]J = Raekkenr + 1
ws.Columns("A").Rows(J).Value = AnsvarligeSygepl.Text
ws.Columns("B").Rows(J).Value = Dato.Text
ws.Columns("C").Rows(J).Value = Uge.Text
ws.Columns("D").Rows(J).Value = Vagt.Text
ws.Columns("A").Rows(J).Copy ws.Columns("A").Rows(J).Resize(15, 1)
J = J + 15 [/vba]
I hope someone can help me, thank you in advance.

[vba]Private Sub CmdComplete_Click()
svar = MsgBox("Ønsker du at afslutte besvarelsen for Team 1?", vbYesNo, "Afslut besvarelse")
If svar = vbYes Then
svar = MsgBox("Du har nu afsluttet indtastningen", vbOKOnly, "Tak")
Call Resultat
End
Else
svar = MsgBox("Tilbage til indtastningen", vbOKOnly, "Om igen")
End If
End Sub
Private Sub Resultat()
Dim ws As Worksheet, Con As Controls, Raekkenr As Long, i As Long, Number As Long, Spm1 As Long, J As Long
Set ws = Worksheets("Data_Team1")
Raekkenr = ws.Cells(1, 1).CurrentRegion.Rows.Count
J = Raekkenr + 1
ws.Columns("A").Rows(J).Value = AnsvarligeSygepl.Text
ws.Columns("B").Rows(J).Value = Dato.Text
ws.Columns("C").Rows(J).Value = Uge.Text
ws.Columns("D").Rows(J).Value = Vagt.Text
ws.Columns("A").Rows(J).Copy ws.Columns("A").Rows(J).Resize(15, 1)
J = J + 15
With ws
Raekkenr = Raekkenr + 1
'Sengeplads 1.1
i = 6
For Number = 1 To 13
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "1.1"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 1.2
i = 6
For Number = 14 To 26
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "1.2"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 1.3
i = 6
For Number = 27 To 39
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "1.3"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 2.1
i = 6
For Number = 40 To 52
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "2.1"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 2.2
i = 6
For Number = 53 To 65
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "2.2"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 2.3
i = 6
For Number = 66 To 78
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "2.3"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 3.1
i = 6
For Number = 79 To 91
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "3.1"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 3.2
i = 6
For Number = 92 To 104
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "3.2"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 4.1
i = 6
For Number = 105 To 117
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "4.1"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 4.2
i = 6
For Number = 118 To 130
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "4.2"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 5.1
i = 6
For Number = 131 To 143
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "5.1"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 5.2
i = 6
For Number = 144 To 156
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "5.2"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 6.1
i = 6
For Number = 157 To 169
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "6.1"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 6.2
i = 6
For Number = 170 To 182
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "6.2"
i = i + 1
Next
Raekkenr = Raekkenr + 1
'Sengeplads 7
i = 6
For Number = 183 To 195
.Cells(Raekkenr, i).Value = Team1.Controls("Tx" & Number).Text
.Cells(Raekkenr, 5).Value = "7"
i = i + 1
Next
i = 19
For Number = 1 To 6 Step 2
If Team1.Controls("optionbutton" & Number).Value = True Then
.Cells(Raekkenr, i).Value = "1"
Else: .Cells(Raekkenr, i).Value = "0"
End If
i = i + 1
Next
End With
Worksheets("Data_Team1").Columns.AutoFit
Spm1 = Worksheets("Spm.1.").Columns("A").CurrentRegion.Rows.Count + 1
Worksheets("Spm.1.").Cells(Spm1, 1).Value = Uge.Text
Worksheets("Spm.1.").Cells(Spm1, 2).Value = "1"
End Sub

Private Sub Forudfyld_Click()
Dim i As Integer, J As Integer
For i = 1 To 195
Team1.Controls("Tx" & i).Text = 1
Next
For J = 13 To 195 Step 13
Team1.Controls("Tx" & J).Text = ""
Next
End Sub[/vba]

[Bob Phillips]

Ann, can you post the workbook so that we can play with it?

[Ann]

Of course, but I can only attach a file with the size of 1.00 MB. Even if I delete all irrelevant stuff and zip it, it's still 8 MB.
Are there any solutions to this?

[Ann]

There, I fixed it.
Hopefully you can help me now

I want to fill out the Questionnaire 'Team 1 Checkliste' in sheet "Udfyld Skema" and then print out the answers in sheet "Data Team 1".
Afterwards it's suppose to automatically update the graphs in sheet 'Grafisk'.
Hope it makes sense..

[mdmackillop]

There is a compile error here

[VBA]Private Sub Resultat()
'....
Raekkenr = ws.Cells(1.1).CurrentRegion.Rows.Count
.Columns.AutoFit 'Needs ws.Columns.AutoFit
End Sub[/VBA]

Your formula in col V is putting your data into Row 977,
try

[VBA]'Raekkenr = ws.Cells(1, 1).CurrentRegion.Rows.Count
Raekkenr = ws.Cells(Rows.Count, 1).End(xlUp).Row
[/VBA]

[Ann]

It works now Thank you so much.
It's very slow, but that's ok for now. Thanks