Repeat the question and if again in funktion

[Annemus]

Hello
I have made the following VBA code, and it works.. But I would like to make it start over again if they write a number, that does not exist. And again. So it asks about rewritting the number, if it does not exist. I have marked it with red .


Sub Fjernelse()
Dim iRemove As Integer
iRemove = MsgBox("Do you want to delete a car?", vbYesNo)
Do While iRemove = vbYes

iRemove = InputBox("Which car do you want to remove? Write the number of the car:")
If iRemove = Range("A2").Value Then
Range("A2:C2").Select
Selection.ClearContents
Range("A3:C6").Select
Selection.Copy
Range("A2").Select
ActiveSheet.Paste
ElseIf iRemove = Range("A3").Value Then
Range("A3:C3").Select
Selection.ClearContents
Range("A4:C6").Select
Selection.Copy
Range("A3").Select
ActiveSheet.Paste
ElseIf iRemove = Range("A4").Value Then
Range("A4:C4").Select
Selection.ClearContents
Range("A5:C6").Select
Selection.Copy
Range("A4").Select
ActiveSheet.Paste
ElseIf iRemove = Range("A5").Value Then
Range("A5:C5").Select
Selection.ClearContents
Range("A6:C6").Select
Selection.Copy
Range("A5").Select
ActiveSheet.Paste
ElseIf iRemove = Range("A6").Value Then
Range("A6:C6").Select
Selaction.ClearContents
Else: MsgBox ("The number of the car do not exist. Try again")
'I want to ask the question again, where it does the same again.
End If

MsgBox ("Car number " & iRemove & " is now removed.")
Loop
End Sub



Thanks

 

[JackDanIce]

I think this will do what you want, but you should really look to use a SELECT CASE statement instead of all the IF ELSE conditions. You should also try not to use so many .Select instructions in your code too

Try:

Sub Fjernelse()

Dim iRemove As Integer
iRemove = MsgBox("Do you want to delete a car?", vbYesNo)
Do While iRemove = vbYes
    iRemove = InputBox("Which car do you want to remove? Write the number of the car:")
    If iRemove = Range("A2").Value Then
        Range("A2:C2").ClearContents
        Range("A3:C6").Copy
        Range("A2").PasteSpecial Paste:=xlValues
    ElseIf iRemove = Range("A3").Value Then
        Range("A3:C3").ClearContents
        Range("A4:C6").Copy
        Range("A3").PasteSpecial Paste:=xlValues
    ElseIf iRemove = Range("A4").Value Then
        Range("A4:C4").ClearContents
        Range("A5:C6").Copy
        Range("A4").PasteSpecial Paste:=xlValues
    ElseIf iRemove = Range("A5").Value Then
        Range("A5:C5").ClearContents
        Range("A6:C6").Copy
        Range("A5").PasteSpecial Paste:=xlValues
    ElseIf iRemove = Range("A6").Value Then
        Range("A6:C6").ClearContents
    Else
        MsgBox ("The number of the car do not exist. Try again")
        iRemove = vbYes
    End If
Loop
On Error GoTo 0
MsgBox ("Car number " & iRemove & " is now removed.")
 
End Sub

 

[Annemus]

Thanks so much

 

[JackDanIce]

You're welcome. This is how it would be with a SELECT CASE statement:

Sub Fjernelse()

Dim iRemove As Integer

iRemove = MsgBox("Do you want to delete a car?", vbYesNo)
Do While iRemove = vbYes
    iRemove = InputBox("Which car do you want to remove? Write the number of the car:")
    Select Case iRemove
        Case Range("A2").Value
            Range("A2:C2").ClearContents
            Range("A3:C6").Copy
            Range("A2").PasteSpecial Paste:=xlValues
        Case Range("A3").Value
            Range("A3:C3").ClearContents
            Range("A4:C6").Copy
            Range("A3").PasteSpecial Paste:=xlValues
        Case Range("A4").Value
            Range("A4:C4").ClearContents
            Range("A5:C6").Copy
            Range("A4").PasteSpecial Paste:=xlValues
        Case Range("A5").Value
            Range("A5:C5").ClearContents
            Range("A6:C6").Copy
            Range("A5").PasteSpecial Paste:=xlValues
        Case Range("A6").Value
            Range("A6:C6").ClearContents
        Case Else
            MsgBox ("The number of the car do not exist. Try again")
            iRemove = vbYes
        End Select
Loop
MsgBox ("Car number " & iRemove & " is now removed.")

End Sub

To me, that is easier to read and understand and has more flexibility/ability than lots of IF... THEN... ELSEIF... Then... END IF

 

[Annemus]

What is the advantage by using cases instead?

Another thing. I just tried the program.. It works, thank you so much.. But if you in answer no to the question, then the text in the end still comes up (the text about the car has been deleted). Hwo can I make this text stop comming, then I press the no botton? (without writting it at the end of every if/case)

 

[Annemus]

I'm about to write the if's to case right now.. Didn't see your last sentence in my hurry.

 

[JackDanIce]

I noticed that problem earlier with your macro but didn't want to suggest too many changes or make change myself.
Try:

Sub Fjernelse()

Dim iRemove As Integer
Dim Car_String As String

Car_String = MsgBox("Do you want to delete a car?", vbYesNo)
Do While Car_String = vbYes
    On Error Resume Next
    iRemove = InputBox("Which car do you want to remove? Write the number of the car:")
    If Application.IsNumber(iRemove) Then
        Car_String = vbNo
        Exit Do
    End If
    Select Case iRemove
        Case Range("A2").Value
            Range("A2:C2").ClearContents
            Range("A3:C6").Copy
            Range("A2").PasteSpecial Paste:=xlValues
        Case Range("A3").Value
            Range("A3:C3").ClearContents
            Range("A4:C6").Copy
            Range("A3").PasteSpecial Paste:=xlValues
        Case Range("A4").Value
            Range("A4:C4").ClearContents
            Range("A5:C6").Copy
            Range("A4").PasteSpecial Paste:=xlValues
        Case Range("A5").Value
            Range("A5:C5").ClearContents
            Range("A6:C6").Copy
            Range("A5").PasteSpecial Paste:=xlValues
        Case Range("A6").Value
            Range("A6:C6").ClearContents
        Case Else
            MsgBox ("The number of the car do not exist. Try again")
            Car_String = vbYes
        End Select
Loop
If Car_String <> vbNo Then MsgBox ("Car number " & iRemove & " is now removed.")

End Sub

 

[Annemus]

You can make so many changes as you want. This is my first assigment in VBA Excel (and MatLab).. So I'm pretty bad at it..
Now I have you.. I have the same problem with another task, but can't make it work eventhough I try to do the same as you did in this question.
If you have the time, I would be glad if you took a look..

Public Sub Tilføjelse()
Dim iNumber As Integer
Dim sType As String
Dim iKm As Integer

'Car number'
iNumber = InputBox("Write the number of the car")
If iNumber = Range("A2").Value Or iNumber = Range("A3").Value Or iNumber = Range("A4").Value Or iNumber = Range("A5").Value Or iNumber = Range("A6").Value Then
MsgBox ("The number of the car does allready exist. Try again")
iNumber = InputBox("Write the number of the car")
On Error GoTo 0 'write the number again and test if it exist
Else: Range("A6").Value = iNumber
End If

'Gastype'
sType = MsgBox("Does the car run on gas?", vbYesNo)
If sType = vbYes Then
Range("B6").Value = "Gas"
sType = "gas"
ElseIf sType = vbNo Then
Range("B6").Value = "Diesel"
sType = "diesel"
End If

'Kilometer pr liter'
iKm = InputBox("Write hwo much the car run pr liter")
Range("C6").Value = iKm
If iKm > 35 Or iKm < 5 Then
MsgBox "value isn't realistic"
iKm = InputBox("Write hwo much the car run pr liter")
Same problem again
Else: Range("C6").Value = iKm
End If
MsgBox ("A new car that runs " & iKm & " km pr. liter " & sType)

'If empty rows in the middle'
If Range("A2").Value = "" Then
Range("A6:C6").Cut
Range("A2").Select
ActiveSheet.Paste
ElseIf Range("A3").Value = "" Then
Range("A6:C6").Cut
Range("A3").Select
ActiveSheet.Paste
ElseIf Range("A4").Value = "" Then
Range("A6:C6").Cut
Range("A4").Select
ActiveSheet.Paste
ElseIf Range("A5").Value = "" Then
Range("A6:C6").Cut
Range("A5").Select
ActiveSheet.Paste
End If
End Sub

 

[Annemus]

It get really mad when I write this:

If Car_String <> vbNo Then MsgBox ("Car number " & iRemove & " is now removed.")

 

[JackDanIce]

As per the rules of this forum, you should create new threads for new problems, please do not post to the bottom of existing threads