Voert code 2 maal uit

Segers · 2 jul 2012

In bijlage mijn code. Hij vraagt twee keer of het een "Part" of "Complete" sale is. Terwijl dit maar 1x zou mogen. Maar kan de fout niet vinden.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim strSale As String
Dim dblCarats As Double
Dim dblA1 As Double
Dim dblTot1 As Double
Dim dblF1 As Double
Dim dblTot2 As Double

Static oldRange As Range
If Not oldRange Is Nothing Then
If oldRange.Address = "$AA$2" Then

strSale = InputBox("Part or Complete?")
If strSale = "Part" Then
Worksheets("Sheet1").Rows(2).Select
'Insert row below active cell
ActiveCell.Offset(1).EntireRow.Insert
Worksheets("Sheet1").Rows(2).Select
'Insert row below active cell
ActiveCell.Offset(1).EntireRow.Insert
Range("A2:Y2").Font.Color = vbGreen
Range("A3:Y3").Font.Color = vbRed
Range("A4:Y4").Font.Color = vbBlack
Range("B3").Value = Range("B2").Value
Range("B4").Value = Range("B2").Value
Range("C3").Value = Range("C2").Value & "A"
Range("C4").Value = Range("C2").Value & "B"
Range("D3").Value = Range("B3").Value & "-" & Range("C3").Value
Range("D4").Value = Range("B4").Value & "-" & Range("C4").Value
strCarats = InputBox("How many carats has been sold?")
strF1 = InputBox("What was the final price per Carat?")
Range("L3").Value = strCarats
Range("O3").Value = strF1
Range("P3").Value = strF1 * strCarats
Range("L4").Value = Range("L2").Value - Range("L3").Value
Range("M4").Value = Range("M2").Value
Range("N4").Value = Range("M2").Value * Range("L4").Value
ElseIf strSale <> "Part" And strSale <> "Complete" Then
strSale = InputBox("Part or Complete?")
ElseIf strSale = "Complete" Then
Range("A2:Y2").Font.Color = vbRed
Range("M2

2").Locked = True
End If
End If

End If

Set oldRange = Target

End Sub

paulva · 2 jul 2012

De code lokt misschien het eigen event uit. Daarom is het nogal eens een goed idee om als allereerste opdracht die events uit te schakelen.

Code:

Application.EnableEvents = False

en helemaal achteraan die events alweer in te schakelen.

Code:

Application.EnableEvents = True

lord anubis · 2 jul 2012

Ik ben geen VB expert, integendeel.
Om je code wat overzichtelijk te maken wat de flow betreft, het volgende.

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ....

If Not oldRange Is Nothing Then
    If oldRange.Address = "$AA$2" Then
        strSale = InputBox("Part or Complete?")
        If strSale = "Part" Then
            Worksheets("Sh...
            ...
        ElseIf strSale <> "Part" And strSale <> "Complete" Then
            strSale = InputBox("Part or Complete?")
        ElseIf strSale = "Complete" Then
            ...
        End If
    End If

End If

....

End Sub

Dit is wat ik zie, de mogelijkheid om toch twee je vraag "Part or Complete?" te krijgen.

Wat ik het tot zou veranderen om de code wat duidelijker te maken is ( Want waarom zou je testen op wat het niet moet zijn , als je weet wat het wel moet zijn. Tevens handel eerst de juiste keuze af en daarna pas de afwijzing ).

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim ....

If Not oldRange Is Nothing Then
    If oldRange.Address = "$AA$2" Then

        strSale = InputBox("Part or Complete?")
        If strSale = "Part" Then
            Worksheets("Sh...
            ...
        ElseIf strSale = "Complete" Then
            ...
        else
            strSale = InputBox("Part or Complete?")
        End If
    End If

End If
....
End Sub

Tevens reist bij mij de vraag wat doe je met de tweede vraag? Wat wil je bereiken? Als iemand nu een fout maakt springt deze na de tweede vraag eruit en dat wil je niet. Al zou je een juiste keuze maken dan springt het toch uit de routine.

Zou achter je eerste vraag een Trim plaatsen om alle onnodige spaties ( whitespace ) te verwijderen van de input string strSale. Ook zou ik strSale volledig upper case ( UCase geloof ik ) maken en dan de vergelijking doen met "PART" en "COMPLETE".

Tevens een kan je het in een while loop zetten zodat als je een foutieve ingave gaf je deze kan corrigeren.
B.v door een extra input keuze te geven van een '.' (punt) of het woord .exit'.

Zoiets als

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
Dim ....

If Not oldRange Is Nothing Then
    If oldRange.Address = "$AA$2" Then

        strSale = InputBox("'Part' or 'Complete'? type a dot for Exit.")
        strSale = trim ....  even vergeten hoe je ook tabs verwijderd. even zoeken op trim en whitspace
        while strSale <> '.' then
            Select Case UCase(strSale) 
            Case "PART"
                ... Do your Part thing
                ...
            Case "COMPLETE" Then
                ... Do your Complete thing
                ...
            Case Else
                strSale = InputBox("Choose from 'Part' or 'Complete'? type a dot for Exit. Please try again!")
            End Select
        wend
    End If

End If
....
Application.EnableEvents = True - indien nodig
End Sub

Echter zou het nog steeds even goed kunnen dat er een recursieve aan roep naar jouw subroutine gedaan word.
Zet hier en daar een log methode erin om te checken wat je flow doet.
Kijk ook even naar de input, door deze iets te wijzigen zie je gelijk welke input het was. Desnoods met een tellertje om te testen hoe vaak.
Er zitten misschien wat type fouten in maar dit is het idee i.i.g.

HTH

Succes

PS, zet even je geplaatste code tussen code Tags. Is het # teken boven je tekst ingaven deel. Geeft gelijk een beter beeld.

Segers · 4 jul 2012

Beste Lord Anubis,

Nu voert hij 2x die vraag uit terwijl dit maar 1x moet gebeuren. Ik ben momenteel bezig mijn code aan het herwerken want mijn "parcel" bestaat uit 20 lijnen maar natuurlijk als je lijnen invoegt moet hij daar in het verdere verloop rekening mee houden en daar zit ik nog mee te knoeien.

Alvast bedankt voor uw moeite,
Josefien

lord anubis · 4 jul 2012

Dan haal je de vraag toch weg. Speciaal in een Case geplaatst om je duidelijk te maken dat het makkelijk te verwijderen is.
Hij voert de tweede vraag alleen uit als je een fout typed. En dat is afhankelijk van je string compare. Dus 'Part' en 'part' kunnen verschillend zijn.
Anders kom je nooit bij de tweede vraag.

Wat bedoel je met Parcel? Is dat een ingave mogelijkheid van 20 mogelijkheden ...?

Even voor je zelf afvragen. Wat wil je dat er gebeurd als iemand een fout letter intypt? Er volledig uitspringt of een herkansing krijgt?

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
Dim ....

If Not oldRange Is Nothing Then
    If oldRange.Address = "$AA$2" Then

        strSale = InputBox("'Part' or 'Complete'?")
        strSale = trim ....  even vergeten hoe je ook tabs verwijderd. even zoeken op trim en whitspace
        while strSale <> '.' then
            Select Case UCase(strSale) 
            Case "PART"
                ... Do your Part thing
                ...
            Case "COMPLETE" Then
                ... Do your Complete thing
                ...

            End Select
        wend
    End If

End If
....
Application.EnableEvents = True - indien nodig
End Sub

Dus in jouw eerste voorbeeld geval komt het op het volgende neer. ( PS. je heb je code nog niet aangepast met Code tags. Leest makkelijker Knopje 'Bericht Aanpassen' )
Ik weet natuurlijk niet of je Worksheet code juist is en kan niet zien of er een event plaats vind als je een Worksheet

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
Dim ....

If Not oldRange Is Nothing Then
    If oldRange.Address = "$AA$2" Then

        ' Question:
        strSale = InputBox("'Part' or 'Complete'?")
        strSale = trim ....  even vergeten hoe je ook tabs verwijderd. even zoeken op trim en whitspace
        while strSale <> '.' then
            Select Case UCase(strSale) 
            Case "PART"
                '... Do your Part thing
                Worksheets("Sheet1").Rows(2).Select
                'Insert row below active cell
                ActiveCell.Offset(1).EntireRow.Insert
                Worksheets("Sheet1").Rows(2).Select
                'Insert row below active cell
                ActiveCell.Offset(1).EntireRow.Insert
                Range("A2:Y2").Font.Color = vbGreen
                Range("A3:Y3").Font.Color = vbRed
                Range("A4:Y4").Font.Color = vbBlack
                Range("B3").Value = Range("B2").Value
                Range("B4").Value = Range("B2").Value
                Range("C3").Value = Range("C2").Value & "A"
                Range("C4").Value = Range("C2").Value & "B"
                Range("D3").Value = Range("B3").Value & "-" & Range("C3").Value
                Range("D4").Value = Range("B4").Value & "-" & Range("C4").Value
                ' Question:
                strCarats = InputBox("How many carats has been sold?")
                strF1 = InputBox("What was the final price per Carat?")
                Range("L3").Value = strCarats
                Range("O3").Value = strF1
                Range("P3").Value = strF1 * strCarats
                Range("L4").Value = Range("L2").Value - Range("L3").Value
                Range("M4").Value = Range("M2").Value
                Range("N4").Value = Range("M2").Value * Range("L4").Value
                ' Einde Case PART
            Case "COMPLETE" Then
                '... Do your Complete thing
                Range("A2:Y2").Font.Color = vbRed
                Range("M2:P2").Locked = True
                ' Einde Case Complete
            End Select
        wend
    End If

End If
....
Application.EnableEvents = True - indien nodig
End Sub

Warme bakkertje · 4 jul 2012

@ lord anubis
bij je inputbox gebruik je strSale
en bij je While...Wend en Select Case gebruik je strScale
Waarschijnlijk typo maar verhindert wel de correcte werking.

lord anubis · 4 jul 2012

Warme bakkertje zei:
@ lord anubis
bij je inputbox gebruik je strSale
en bij je While...Wend en Select Case gebruik je strScale
Waarschijnlijk typo maar verhindert wel de correcte werking.

Was iid een typo. TV kijken, en dit gaat toch niet altijd samen.

Maar de TS had dit ook wel ontdekt en opgelost, toch? Als je code overneemt, check je het toch op correctheid?

Heb het inmiddels aangepast. Evengoed bedankt voor het vinden hiervan.
Je hoef maar één keer een fout te maken en met copy paste staat het overal. Erg besmettelijk. Ahum misschien kunnen ze dit nu in 'Independence Day' gebruiken om die rotzakken te besmetten. ;-)

Voert code 2 maal uit

Segers

Gebruiker

paulva

Gebruiker

lord anubis

Nieuwe gebruiker

Segers

Gebruiker

lord anubis

Nieuwe gebruiker

Warme bakkertje

Meubilair

lord anubis

Nieuwe gebruiker

Nieuwste berichten

Wij waarderen jouw privacy