Copy long questions from a question pool on excelsheet to other sheet-CodePudding

I have long questions on a sheet in the column A and in the column B are the points of the questions. I want that the Macro copies 20 questions randomly of the question bank with the points to another Sheet. I create the Macro but the problem which I have is that some questions are too long so that I get the Ad "type mismatch". The macro is working with just short questions.

Private Sub CommandButton1_Click()
Dim i, RowNum
Dim Text As String

Sheets("Sheet1").Range("A:A").ClearContents
Sheets("Sheet1").Range("B:B").ClearContents
Text = "Summe der Punkte"
For i = 1 To 20
  
generate:

RowNum = Application.RoundUp(Rnd() * 100, 0)

If Application.CountIf(Sheets("Sheet1").[A:A], Sheets("Sheet2").Cells(RowNum, "A")) = 0 & Application.CountIf(Sheets("Sheet1").[B:B], Sheets("Sheet2").Cells(RowNum, "B")) = 0 Then

Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1).Value = Sheets("Sheet2").Cells(RowNum, "A").Value
Sheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Offset(1).Value = Sheets("Sheet2").Cells(RowNum, "B").Value
Else
GoTo generate
End If



Next i
Sheets("Sheet1").Select
Range("B23") = WorksheetFunction.Sum(Columns(2))
Range("A23") = Text


End Sub

Can you help me how I can change the code that the macro is working with long questions. One opportunity I thought about is to define names with the names manager, but I don't know how to program that in VBA.

e.g here one question of my question bank in the sheet.

What does a red dot on a measuring device / device mean?
    ____________________________________________________________________________ 
    
    ____________________________________________________________________________ 
    
    ____________________________________________________________________________

, here is e.g the problem, If I just make one line it is working

Any assistance most humbly and gratefully accepted

CodePudding user response：

Your error is appearing on this line:

If Application.CountIf(Sheets("Sheet1").[A:A], Sheets("Sheet2").Cells(RowNum, "A")) = 0 & Application.CountIf(Sheets("Sheet1").[B:B], Sheets("Sheet2").Cells(RowNum, "B")) = 0 Then
'                                                                                       ^

You've used an & instead of And.

Try:

If Application.CountIf(Sheets("Sheet1").[A:A], Sheets("Sheet2").Cells(RowNum, "A")) = 0 And Application.CountIf(Sheets("Sheet1").[B:B], Sheets("Sheet2").Cells(RowNum, "B")) = 0 Then
'                                                                                       ^^^

CodePudding user response：

Couple of things

As you mentioned, you can use named ranges but defining objects will also make your life easier.
Understand the difference between & Operator (Visual Basic) and And operator
It is always a good idea to handle the errors.

Copy the entire code from below with the numbers and then try it for me (Untested). Let me know what error do you get.

Private Sub CommandButton1_Click()
10        On Error GoTo Whoa
      
          Dim wsA As Worksheet
          Dim wsB As Worksheet
      
          Dim i As Long, RowNum As Long
          Dim lRow As Long
          Dim Txt As String

20        Set wsA = Sheets("Sheet1")
30        Set wsB = Sheets("Sheet2")
      
40        wsA.Columns("A:B").ClearContents
      
50        Txt = "Summe der Punkte"
      
60        For i = 1 To 20
70            RowNum = Application.RoundUp(Rnd() * 100, 0)

80            If Application.CountIf(wsA.Columns(1), wsB.Cells(RowNum, "A")) = 0 And _
             Application.CountIf(wsA.Columns(2), wsB.Cells(RowNum, "B")) = 0 Then
              
90                lRow = wsA.Range("A" & wsA.Rows.Count).End(xlUp).Row   1
100               wsA.Range("A" & lRow).Value = wsB.Cells(RowNum, "A").Value
              
110               lRow = wsA.Range("B" & wsA.Rows.Count).End(xlUp).Row   1
120               wsA.Range("B" & lRow).Value = wsB.Cells(RowNum, "B").Value
130           End If
140       Next i
      
150       wsA.Range("B23") = WorksheetFunction.Sum(wsA.Columns(2))
160       wsA.Range("A23") = Txt
      
LetsContinue:

170       Exit Sub
Whoa:
180       MsgBox Err.Description & vbNewLine & _
          " Error on line " & Erl & _
          " Value of i : " & i & _
          " Value of RowNum : " & RowNum
          
190       Resume LetsContinue
End Sub