loop tot de eerste cel die niet voldoet aan voorwaarde

[shivalli]

Hallo,
Voor het verwijderen van lege kolommen gebruik ik onderstaande script:
Sub kolldel()

Application.ScreenUpdating = False
LastColum = Cells(9, Columns.Count).End(xlToLeft).Column
For icol = LastColum To 5 Step -1
If Cells(9, icol).Value = "x" Then Cells(9, icol).EntireColumn.Delete
Next
Application.ScreenUpdating = True

End Sub
Het gaat om een groot bestand met ongeveer 1100 kolommen. Dus duurt het even voordat alle lege kolommen verwijderd zijn.
Is het mogelijk om onderstaande script aan te passen, dat de loop stopt bij de eerste cel die niet voldoet aan de voorwaarde. Dus als in rij 9 iets anderst staat dan een "x", hoeven de andere kolommen hierna niet meer verwijderd te worden (die zijn namelijk niet leeg).
Dan hoeft de macro niet te loopen tot kolom 5, maar tot de eerste kolom waarin iets anders staat dan x
Ik hoop dat mijn vraag duidelijk is, anders hoor ik het graag.
gr en alvast dank

 

[Niels28]

In het vervolg graag de codetags (#) gebruiken

Application.ScreenUpdating = False
LastColum = Cells(9, Columns.Count).End(xlToLeft).Column
Set r = Range("9:9").Find("x")
For icol = LastColum To r.Column Step -1
If Cells(9, icol).Value = "x" Then Cells(9, icol).EntireColumn.Delete
Next
Application.ScreenUpdating = True

Niels

 

[shivalli]

Niels, Dankjewel!
precies wat ik zoek.
Ik wil het met enige aanpassing gebruiken om ook lege rijen te verwijderen.
Wat doe ik verkeerd in onderstaande script:
Sub Inz()

Application.ScreenUpdating = False
LastRow = Cells(Rows.Count, 2).End(xlToLeft).Row
Set r = Range("B:B").Find("")
For irow = LastRow To r.Row Step -1
If Cells(irow, 2).Value = "" Then Cells(irow, 2).EntireRow.Delete
Next
Application.ScreenUpdating = True
End Sub
De loop moet stoppen bij de eerste niet lege cel in kolom B

gr,
S

 

[Niels28]

graag de codetags (#) gebruiken dan komt de code in een apart vak te staan en leest het makkelijker.
Hij stop wel bij de eerste niet lege cel maar je begint in rij 1048576 en heeft dus heel wat lege rijen te verwijderen.

LastRow = Cells(Rows.Count, 2).End(xlUp).Row

Niels

 

[shivalli]

Dankjewel, ik begrijpt het.
Was ik ook al een beetje achter gekomen.
ben een beetje aan het puzzelen geweest met onderstaande.
Wat vind je ervan, is het een goede oplossing? of weet je iets anders?
Dank alvast en excuses voor de codetags (had ze nog niet ontdekt)

Sub Inz
Application.ScreenUpdating = False
Dim maxrow As Long
    maxrow = [LOOKUP(2,1/(B11:B510<>""),ROW(B11:B510))]
With ActiveSheet
    .Rows(maxrow + 1 & ":" & 510).Delete
End With
Application.ScreenUpdating = True
End Sub

 

[Niels28]

Leuke oplossing , kan korter

Sub Inz()

Cells(Rows.Count, 2).End(xlUp).Offset(1).Resize(510 - Cells(Rows.Count, 2).End(xlUp).Row, 1).EntireRow.Delete

End Sub

Niels

 

[shivalli]

Hoi Niels,
Heb script uitgeprobeerd, werkt perfect.
maar nog een vraagje om het beter te begrijpen:

Sub Inz()

Cells(Rows.Count, 2).End(xlUp).Offset(1).Resize(510 - Cells(Rows.Count, 2).[B][COLOR="#FF0000"]End(xlUp).Row, 1[/COLOR][/B]).EntireRow.Delete

End Sub

Waarom kies je voor 1 hier? Ik zou voor 2 gekozen hebben, omdat je uitgaat van kolom B, of is dit een domme vraag?

gr,
S

 

[Niels28]

ik kies voor 1 omdat zit met de resize te maken heeft en je een bereik nodig hebt van 1 kolom breed.

Niels

 

[shivalli]

Oh zo, duidelijk.
Dankjewel voor het mee willen denken en je uitleg. Ik waardeer het enorm en leer zo elke keer weer iets
gr,
S