PDA

View Full Version : Solved: questionnaire



Ann
12-29-2011, 04:07 AM
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:

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:D").Rows(J).Copy ws.Columns("A:D").Rows(J).Resize(15, 1)
J = J + 15
I hope someone can help me, thank you in advance.

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:D").Rows(J).Copy ws.Columns("A:D").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

Bob Phillips
12-29-2011, 04:36 AM
Ann, can you post the workbook so that we can play with it?

Ann
12-29-2011, 05:35 AM
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
12-29-2011, 06:15 AM
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
12-29-2011, 11:27 AM
There is a compile error here

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

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

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

Ann
01-09-2012, 02:56 AM
It works now :) Thank you so much.
It's very slow, but that's ok for now. Thanks :)