Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Type mismatch error
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("D6:D7").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("D6:D7").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("D6:D7,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. |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Visual Basic Error Run Time Error, Type Mismatch | Excel Discussion (Misc queries) | |||
Help with type mismatch error | Excel Programming | |||
Conditional Formatting - Run Time Error '13' Type Mismatch Error | Excel Programming | |||
Help: Compile error: type mismatch: array or user defined type expected | Excel Programming | |||
Befuddled with For Next Loop ------ Run - Time Error '13' Type Mismatch Error | Excel Programming |