Range selecteren mbv userform

[globe]

Hallo Helpmijers.

Ik heb een VBA project waarbij een range van een werksheet naar een nieuw workbook wordt gekopieerd.

Dit doe ik met de functie

Range("G:G,L:L").Copy


Workbooks.Add

ActiveWorkbook.Activate

Range("A1").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Dit werkt gewoon zonder problemen.

Nu hebben we een aanpassing in ons systeem waardoor te kopiëren kolommen variabel kunnen zijn. Dus niet meer standaard G en L.

Ik wil dus een userform laten verschijnen waarbij de gebruiker de kolommen moet aanklikken of een waarde moet ingeven.
De mooiste oplossing is op een cel klikken in de gewenste kolom en deze complete kolom dan als range instellen.

Dit zal dus 2 maal moeten gebeuren aangezien ik een range heb van 2 (niet naastgelegen) kolommen.

Kan dat?

 

[edmoor]

Dat kan zo:

Set Bereik = Application.InputBox("Selecteer een bereik", , , , , , , 8)

Bereik is dan een Range object.
Dar bereik kan je met de muis selecteren.

 

[globe]

Dank Ed voor je snelle reactie.

Dit werkt prima inderdaad maar is niet helemaal wat ik bedoel.
Ik wil gewoon een kolom kunnen aanklikken (2 maal in mijn geval) zonder een range te kunnen bepalen.
Als mensen nu een range selecteren van meerdere rijen verdeeld over meerdere kolommen gaat de output niet goed.

Mooiste zou zijn dat er 2 maal een popup komt.

1. Selecteer kolom 1, dan klikken op een cel binnen deze kolom.

2. Selecteer kolom 2, dan klikken op een cel binnen deze kolom.

Je hebt dan 2 kolommen die de range moeten bepalen.

 

[edmoor]

Dan kan gewoon met wat ik liet zien.
Klik op een kolom, druk de Ctrl toets in en klik op een andere kolom.
Zo ook met afzonderlijke cellen.

 

[globe]

Dat is inderdaad zeker zo Ed. Maar ik wil het foolproof maken.

Gebruikers kunnen met jouw oplossing namelijk ook meerdere kolommen selecteren ipv de 2 benodigde. En dan gaat het eindresultaat niet goed helaas.

 

[edmoor]

Kijk eens naar dit:

Set Bereik = Application.InputBox("Selecteer een bereik", , , , , , , 8)
If UBound(Split(Bereik.Address, ",")) > 1 Then
    MsgBox "Max 2 kolommen selecteren", vbCritical, "FOOL"
    Exit Sub
End If

 

[globe]

You Fool

werkt helaas niet, ik kan nog steeds meerdere rijen selecteren, ook met CTRL ingedrukt.

 

[edmoor]

Uiteraard.
Een gebruiker kan altijd meerdere cellen of kolommen selecteren.
Maar in de code controleer je er op.

 

[globe]

Dat bedoel ik niet Ed.

Je kunt bv. B:E en G:Y selecteren. dat zijn dus meer dan 2 kolommen. Wat niet werkt is 3 variabelen selecteren, dan krijg je idd de FOOL melding.
Dus A:A, C:C, N:M geegt een foutmelding.

 

[edmoor]

Ik begrijp het niet meer.
Je wilt toch maximaal 2 kolommen toestaan?
Het stukje code dat ik plaatste controleert daar op.
Je kan dus niet zoals in je voorbeeld kolom B en E en G en Y selecteren.
En ook niet A en C en N en M.

Geen idee dus hoe je selecteert.

 

[globe]

Ik begrijp het niet meer.
Je wilt toch maximaal 2 kolommen toestaan?
Het stukje code dat ik plaatste controleert daar op.
Je kan dus niet zoals in je voorbeeld kolom B en E en G en Y selecteren.
En ook niet A en C en N en M.

Geen idee dus hoe je selecteert.

Ik waardeer je hulp enorm en wellicht ben ik niet helemaal duidelijk:

Check even bijgaande screenshot.

In deze screen shot selecteer is 2 maal een aantal kolommen. Jouw script checkt hoeveel ranges er geselecteerd worden. In mijn geval 2 x een range van 4 kolommen, dus 8 in totaal.
Het zou mooi zijn wanneer er (met of zonder CTRL) slecht 2 maal 1 kolom geselecteerd zouden kunnen worden.

Ik krijg wel een foutmelding maar daarna gaat het script gewoon verder wanneer ik deze foutmelding dicht klik. Met de 8 geselecteerde kolommen.
Het script zou eigenlijk weer een stap terug moeten doen.

If Then? oid?

 

[edmoor]

Wat je daar laat zien werkt prima met de code die ik al gaf.
Maximaal 2 selecties van 1 of meerdere kolommen.
Dat is precies waar mijn stukje code op controleert met:

If UBound(Split(Bereik.Address, ",")) > 1 Then

 

[globe]

Wat je daar laat zien werkt prima met de code die ik al gaf.
Maximaal 2 selecties van 1 of meerdere kolommen.
Dat is precies waar mijn stukje code op controleert met:

If UBound(Split(Bereik.Address, ",")) > 1 Then

Dat klopt inderdaad en werkt prima. Maar als ik meer dan 2 kolommen selecteer krijg ik een foutmelding dat er meer dan 2 kolommen zijn geselecteerd en vervolgens loopt mijn script gewoon door. Dat moet natuurlijk niet.
Er moet dan de keuze komen om het nogmaals te proberen.

 

[edmoor]

Daarom staat die Exit Sub er in.
Als je wilt dat er dan iets anders gebeurt kan je dat daar doen.

 

[globe]

Aha, dat maakt een hoop duidelijk.

Ik heb er dit van gebakken nu en lijkt prima te werken. Waanzinnig bedankt to zover!

Bereik:

Set Bereik = Application.InputBox("Selecteer een bereik", , , , , , , 8)
If UBound(Split(Bereik.Address, ",")) > 1 Then
    MsgBox "Max 2 kolommen selecteren", vbCritical, "FOOL"
    
    GoTo Bereik
    
    Exit Sub
End If

Bereik.Copy

 

[edmoor]

Zo mogen ze het maximaal 3x fout doen:

Sub SelecteerBereik()
    Dim CorrectBereik As Boolean
    Dim AantalKeer As Byte
    
    Do While Not CorrectBereik
        If AantalKeer = 3 Then GoTo Einde
        Set Bereik = Application.InputBox("Selecteer een bereik", , , , , , , 8)
        If UBound(Split(Bereik.Address, ",")) > 1 Then
            MsgBox "Max 2 kolommen selecteren", vbCritical, "FOOL"
            AantalKeer = AantalKeer + 1
        Else
            CorrectBereik = True
        End If
    Loop
    
Einde:
End Sub

 

[globe]

dank!

Ik had ook al een oplossing gevonden maar die van jou lijkt nog net wat netter.

 

[globe]

    Sub select_column()
Dim rng As Range
Set rng = Application.InputBox("Selecteer kolom 1", Type:=8)
If Not rng Is Nothing Then Set rng = rng.EntireColumn
rng.Select


Dim rng2 As Range
Set rng2 = Application.InputBox("Selecteer kolom 2", Type:=8)
If Not rng2 Is Nothing Then Set rng2 = rng2.EntireColumn
rng2.Select


Workbooks.Add

rng.Copy

Range("A1").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
rng2.Copy

Range("b1").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False




End Sub

Deze doet eigenlijk exact wat ik wil

zelfs als er slechts 1 cell binnen een kolom wordt geselecteerd.

 

[edmoor]

Wat jij wil natuurlijk.
Maar dan kan men nog steeds meer dan 1 kolom per keer selecteren.

 

[snb]

Ik deed het zó:

Sub M_snb()
  With Application
    Range(.InputBox("1e kolom", Type:=8).EntireColumn.Address & "," & .InputBox("2e kolom", Type:=8).EntireColumn.Address).Copy
  End With

  Workbooks.Add().Sheets(1).Paste
End Sub

En als @Edm moeilijk doet over meer dan 1 kolom:

Sub M_snb()
  With Application
    Range(.InputBox("1e kolom", Type:=8).EntireColumn.Resize(, 1).Address & "," & .InputBox("2e kolom", Type:=8).EntireColumn.Resize(, 1).Address).Copy
  End With

  Workbooks.Add().Sheets(1).Paste
End Sub

Het kan zelfs zó (en is ook veel sneller)

Sub M_snb()
  With Application
    Range(.InputBox("1e kolom", Type:=8).EntireColumn.Resize(, 1).Address & "," & .InputBox("2e kolom", Type:=8).EntireColumn.Resize(, 1).Address).Copy Workbooks.Add().Sheets(1).Cells(1)
  End With
End Sub