Cellen omwisselen en auto selectie

[Kacik]

Goedendag allemaal,

Ik heb klein probleem. Onderstaande code gebruikt ik voor omwisselen van cellen. En dit werk prima.

[I][I]Sub Swap()
Dim cval(), cadd()
a = 1
ReDim cval(2), cadd(2)
For Each usrcell In Selection
cval(a) = usrcell.Value
cadd(a) = usrcell.Address
a = a + 1
If Selection.Count <> 2 Then Exit Sub
Next usrcell
Range(cadd(1)).Select
ActiveCell = cval(2)
Range(cadd(2)).Select
ActiveCell = cval(1)
End Sub

Bij deze mij vraag:
Is het mogelijk aanpassen deze code zo dat als ik maak keus van en cel, automatisch woord mee genomen vorige cel? En deze selectie moet mij macro bewerken. Ik ben niet zo sterk in VBA.

Alvast bedankt,

gr. Artur

 

[VenA]

En de vraag is? Misschien dat je beter een voorbeeldje kan plaatsen. Om code een beetje leesbaar te maken zijn de CODE-Tags uitgevonden! Is deze code voor windows of voor een ander besturingssysteem?

 

[Kacik]

Ja zeker.
Ik moet nu handmatig keus maken welke cellen wil ik omwisselen. En in de toekomst is de bedoeling : als rak ik een cel automatisch in de selectie word mee genomen vorige of volgende cel.

 

[HSV]

Test het zo eens Artur.

Sub Swap()
ReDim cval(2)
With ActiveCell
   If .Row < 3 Or .Row > 8 Or Selection.Count <> 1 Then Exit Sub
    cval(a) = .Value
  a = a + 1
    cval(a) = .Offset(-1)
 .Offset(-1).Resize(2) = Application.Transpose(cval)
   Application.Goto .Offset(-1)
 End With
End Sub

 

[Kacik]

Hoi Harry,

Ja dat werkt prima. Maar nu heb ik andere probleem. In een blad gebruikt ik twee macro's.

1. Een is cellen omwisselen,
2. En de anderen verberg rijen welke zijn leeg. (zie bestand)

Nu bij de tweede macro krijg ik fout melding?

Ik ben niet zo sterk nog in VBA. Meestal gebruikt ik code welke heb ik gevonden in google. En dan probeer ik wat aanpassen. Bij deze komt ik niet uit.

gr. Artur

 

[HSV]

Dag Artur,

Verder niet gekeken wat de code doet; rode coderegel veranderd.

If Target.Column = 2 Or Target.Column = 11 Then
       [COLOR=#FF0000] If IsEmpty(Target.Value) Then[/COLOR]

 

[Kacik]

Hoi Harry,

Hartelijk bedankt. Nu is het goed. Hij doet pressies wat moet doen. Ik was week mee bezig en met jullie help 2 dagen veder en oplossing is gevonden.
Bij deze ik wens nog iedereen van dit forum fijne kers dagen.

gr. Artur

 

[Kacik]

Goedendag, en Beste Wensen nog...

Onderstaande Code werkt prima met vorige cel. Hoe moet ik dat doen dat nu volgende cel krijg ik omwisselen?

Sub Swap()
ReDim cval(2)
With ActiveCell
   If .Row < 3 Or .Row > 8 Or Selection.Count <> 1 Then Exit Sub
    cval(a) = .Value
  a = a + 1
    cval(a) = .Offset(-1)
 .Offset(-1).Resize(2) = Application.Transpose(cval)
   Application.Goto .Offset(-1)
 End With
End Sub

Alvast bedankt,

Artur

 

[HSV]

Ook de beste wensen Artur.

In het bestand met een spinbutton.

 

[Kacik]

Yes,

Hartelijk bedankt.

gr. Artur