Type mismatch error

[davegb]

Does anyone see what is causing the Type Mismatch error down below as
marked?

Private Sub CommandButton1_Click()
Const PWORD As String = "dave"
Dim wksQuestions As Worksheet
Dim wksSummary As Worksheet
Dim wksText As Worksheet
Dim lQCount As Long
Dim lDataRowCount As Long
Dim lTextRowCount As Long
Dim sQText As String
Dim lQNum As Long
Dim rQAnsLoc As Range
Dim rQ1Answers As Range
Dim rQ2Answers As Range
Dim rQ3Answers As Range
Dim rQ6Answers As Range
Dim rCell As Range
Dim lQSumColCtr As Long
Dim lQTextColCtr As Long
Dim lQRowCtr As Long




Dim rQ1Text As Range
Dim rQ2Text As Range

Set wksSummary = ThisWorkbook.Worksheets("Summary")
Set wksText = ThisWorkbook.Worksheets("Text")
Set wksQuestions = ThisWorkbook.Worksheets("Questions")
Set rQ1Answers = wksQuestions.Range("Q1Answers")
Set rQ1Text = wksQuestions.Range("Q1Text")
Set rQ2Answers = wksQuestions.Range("Q2Answers")
Set rQ2Text = wksQuestions.Range("Q2Text")
Set rQ6Answers = wksQuestions.Range("Q6Answers")
lQCount = wksQuestions.Range("AA1")
lDataRowCount = lQCount + 1


sQText = rQ1Text.Value

Application.ScreenUpdating = False
'REMARK PASSWORD TEMPORARILY
wksQuestions.Unprotect Password:=PWORD

'Copy data from Question sheet to Summary
'Copy Questionaire No, county and Provider to summary

wksQuestions.Range("C3").Copy
wksSummary.Range("A" & lDataRowCount).PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
wksQuestions.Range("D67").Copy
wksSummary.Range("B" & lDataRowCount).PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True

'Copy Answers to Summary
'Copy Q1 Answer to summary
sQText = wksQuestions.Range("Q1Text")

'Copies Q1Text to Summary

'Find the current answer in the answer list
Set rQAnsLoc = rQ1Answers.Find(sQText, LookIn:=xlValues)

lQNum = rQAnsLoc.Offset(0, -1).Value
wksSummary.Range("D" & lDataRowCount) = lQNum

'Test for "Other, please specify" to copy text answer to text sheet
If Trim(sQText) = "Other, please specify" Then
wksQuestions.Range("E9").Copy
wksText.Range("D" & lDataRowCount).PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
'Copy Q2 Answer to summary
sQText = wksQuestions.Range("Q2Text")

'Find the current answer in the answer list
Set rQAnsLoc = rQ2Answers.Find(sQText, LookIn:=xlValues)

'Get the Answer number and enter it in the Summary sheet
lQNum = rQAnsLoc.Offset(0, -1).Value
wksSummary.Range("E" & lDataRowCount) = lQNum

'Test for "Other, please specify" to copy text answer to text sheet
If Trim(sQText) = "Other, please specify" Then
wksQuestions.Range("E11").Copy
wksText.Range("E" & lDataRowCount).PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
'Save Q3 Text to Text sheet

wksQuestions.Range("C3").Copy
wksText.Range("A" & lDataRowCount).PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
wksQuestions.Range("D67").Copy
wksText.Range("B" & lDataRowCount).PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True

wksQuestions.Range("Q3Text").Copy
wksText.Range("F" & lDataRowCount).PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

'Copy Q4 answer to Summary sheet
wksQuestions.Range("Q4No").Copy
wksSummary.Range("F" & lDataRowCount).PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

'Copy Q5 answer to Summary sheet
wksQuestions.Range("Q5Text").Copy
wksSummary.Range("G" & lDataRowCount).PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

'Copy Q6a answer to Summary sheet

lQSumColCtr = 7
lQTextColCtr = 8
lQRowCtr = 20

For Each rCell In wksQuestions.Range("Q6AnsList").Cells

sQText = wksQuestions.Range(rCell.Value).Value

Set rQAnsLoc = rQ6Answers.Find(sQText, LookIn:=xlValues)

lQNum = rQAnsLoc.Offset(0, -1).Value
wksSummary.Cells(lQSumColCtr & lDataRowCount) = lQNum

'Test for "Other, please specify" to copy text answer to text sheet
If Trim(sQText) = "Other" Then
wksQuestions.Range(Cells(lQRowCtr & "E")).Copy '<---TYPE MISMATCH
wksText.Range(Cells(lDataRowCount, lQTextColCtr)).PasteSpecial
Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
lQSumColCtr = lQSumColCtr + 1
lQTextColCtr = lQTextColCtr + 1
lQRowCtr = lQRowCtr + 1


Next rCell

'Set counter for next Questionaire number
lQCount = lQCount + 1
wksQuestions.Range("AA1") = lQCount

'Clear input area and protect sheet
Range("D67,D9:E50").ClearContents
Range("D6").Select
wksQuestions.Protect Password:=PWORD
Application.ScreenUpdating = True

End Sub

I've tried changing that line to:
wksQuestions.Range.Cells(lQRowCtr & "E").Copy
but just get a different error. And I've tried:
wksQuestions.Cells(lQRowCtr & "E").Copy
but it still doesn't run.

Any ideas? Thanks in advance.

 

[Dave Peterson]

Without any testing:

change:
wksQuestions.Range(Cells(lQRowCtr & "E")).Copy

to:
wksQuestions.Cells(lQRowCtr , "E").Copy
or
wksQuestions.Range("E" & lQRowCtr).Copy