VBA code om een selectie te maken binnen een gefilterd tabblad

[defrost]

Goedemiddag,

Binnen een bestaande dataset (rij 4 zijn de headers) wil ik middels VBA een selectie kunnen maken waarbij het aantal te selecteren rijen variabel (in onderstaande code wordt deze variabele bepaald middels een InputBox (=myValue2)) kan zijn. Daarvoor zou ik onderstaande code kunnen gebruiken:

Range("A4").Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count + myValue2 - 1, _
Selection.Columns.Count + 2).Select
Selection.Copy

Deze selecteert een bereik van A5:C'5 + myValue2'.

Deze werkt alleen niet als ik filters op de dataset toepas. De code selecteert dan alsnog A5:C'5 + myValue2', terwijl ik een selectie wil van de eerste zichtbare cel onder A4 en dan 'myValue2' aantal zichtbare rijen naar beneden (en twee kolommen naar rechts). Ik krijg dit alleen niet voor elkaar.

Wie heeft hier een oplossing voor?

 

[edmoor]

Welkom bij Helpmij.
Lees eerst dit eens:
http://www.helpmij.nl/forum/announcement.php?f=5

 

[snb]

Sub M_snb()
  n = InputBox("aantal", " ", 5)
  
  For Each it In UsedRange.Columns(1).Offset(1).SpecialCells(12)
    c00 = c00 & "," & it.Resize(, 3).Address
    p = p + 1
    If p = Val(n) Then Exit For
  Next
  
  Range(Mid(c00, 2)).Select
End Sub

 

[defrost]

Sub M_snb()
  n = InputBox("aantal", " ", 5)
  
  For Each it In UsedRange.Columns(1).Offset(1).SpecialCells(12)
    c00 = c00 & "," & it.Resize(, 3).Address
    p = p + 1
    If p = Val(n) Then Exit For
  Next
  
  Range(Mid(c00, 2)).Select
End Sub

Dank snb, maar ik krijg het met deze code niet werkend. Ik heb een testbestand als bijlage toegevoegd. Doe ik iets fout?

 

[AD1957]

zo?

Sub TEST_1()

  n = InputBox("aantal", " ", 5)
  
  For Each it In [COLOR="#FF0000"]Sheets("Sheet1")[/COLOR].UsedRange.Columns(1).Offset(1).SpecialCells(12)
    c00 = c00 & "," & it.Resize(, 3).Address
    p = p + 1
    If p = Val(n) Then Exit For
  Next
  
  Range(Mid(c00, 2)).Select

Selection.Copy

   
End Sub

 

[defrost]

Dank je Albert. Op die manier werkt het :thumb:

Als ik de totale code waar dit stukje onderdeel van moet worden verder uitbreid (o.a. toepassen filters en nog wat bewerkingen), dan loopt de code echter met regelmaat vast.

Sub TEST_1()

  n = InputBox("aantal", " ", 5)
  
  For Each it In Sheets("Sheet1").UsedRange.Columns(1).Offset(1).SpecialCells(12)
    c00 = c00 & "," & it.Resize(, 3).Address
    p = p + 1
    If p = Val(n) Then Exit For
  Next
  
  [COLOR=#ff0000]Range(Mid(c00, 2)).Select[/COLOR]

Selection.Copy

   
End Sub

Het issue zit volgens de debugger in het rode deel van de code. Ik heb nog geen lijn kunnen ontdekken waardoor de code vastloopt.

 

[Haije]

moet

Range(Mid(c00, 2)).Select

niet zoiets zijn:

Range(Mid(c00, 2,[COLOR="#FF0000"] 3[/COLOR])).Select

m.a.w. je dient ook een aantal karakters op te geven

 

[AD1957]

@deforst,

Je kunt beter @snb bedanken voor deze code.

en nog wat bewerkingen

Zonder de volledige code en voorbeeldbestand kun je geen oplossing verwachten.

Haije,
De 2e parameter is in code van @snb overbodig.
Waarschijnlijk is C00 leeg(door nog wat bewerkingen/filters) of alleen maar komma's

 

[snb]

De code kan alleen maar 'fout' lopen als je werkblad er anders uitziet dan je ons hebt voorgespiegeld.

 

[defrost]

Ik ben erachter waar het fout gaat (al begrijp ik niet goed waarom).

Ik had de default voor de InputBox aangepast naar 25, maar dan loopt de code vast.

Sub TEST_1()

  n = InputBox("aantal", " ", 25)
  
  For Each it In Sheets("Sheet1").UsedRange.Columns(1).Offset(1).SpecialCells(12)
    c00 = c00 & "," & it.Resize(, 3).Address
    p = p + 1
    If p = Val(n) Then Exit For
  Next
  
  [COLOR=#ff0000]Range(Mid(c00, 2)).Select[/COLOR]

Selection.Copy

   
End Sub

Ik ben even gaan 'spelen' met de default en tot 18 gaat het goed, bij een default van 19 of hoger loopt de code vast.

Ik begrijp niet goed waarom een default >18 voor problemen zorgt, maar ik kan er nu in ieder geval mee uit de voeten.

Hartelijk dank allemaal!

 

[AD1957]

Gokje

MsgBox Len(c00)

 

[AD1957]

Misschien niet de meest elegante oplossing.

 

[snb]

Sub M_snb()
  k = UsedRange.Columns(1).Offset(1).SpecialCells(12).count
  do 
    n = InputBox("Max " & k, " ", k)
  loop until n<=k

  For Each it In UsedRange.Columns(1).Offset(1).SpecialCells(12)
    c00 = c00 & "," & it.Resize(, 3).Address
    p = p + 1
    If p = 1 Then Exit For
  Next
  
  Range(Mid(c00, 2)).copy
End Sub