Loopen, maar hoe?

[robert123321]

Hallo,

Ik wil een stuk van mijn macro loopen, maar weet niet goed hoe?
Het stuk in de wat ik wil loopen is in rood getypt.
Ik wil graag dat het stuk code de spaties uit de velden B4 t/m B13 haalt.
Uit B4 wordt de spatie er wel uitgehaald, vervolgens moet die naar B5 springen etc etc tot die een lege cel tegenkomt. Dit kan B14 zijn maar ook een eerdere cel.
Dit is mijn code:

Sub Macro1()

Application.ScreenUpdating = False

Dim owner As String
Dim Nummer As String
Dim X As Variant
Dim R As Range


owner = InputBox("naam")
Nummer = InputBox("Nummer")

Range("A2").Select
Selection = owner
Range("C2").Select
Selection = Nummer

[COLOR="Red"]Do

X = Range("B4")
X = Replace(X, " ", "", 1, 75)
Range("B4") = X

ActiveCell.Offset(0, 1).Select

    Loop Until IsEmpty(ActiveCell.Offset(0, 1))[/COLOR]

Range("B4:B13").SpecialCells(xlCellTypeBlanks).EntireRow.Delete



End Sub

 

[Wigi]

Robert,

Kan je code tussen code tags plaatsen aub? Dat is het # icoon.

 

[huijb]

Done

 

[Wigi]

Thx.

Robert, vergeet die lussen maar. Voor veel problemen heb je geen lus nodig.

Sub Macro1()

    Range("A2") = InputBox("naam")
    Range("C2") = InputBox("Nummer")

    With Range("B4:B13")
        .Replace " ", ""
        .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End With

End Sub

Wigi

 

[robert123321]

Dank je WIGI!!

Hier was ik al een tijd mee aan het klooien. Het werkt nu zoals ik bedoeld had!

Echter nog wel een vraag de volgende code:

.SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Als alle cellen uit de selectie B4 t/m B14 gevuld zijn krijg ik een foutmelding: Fout 1004, er zijn geen cellen gevonden.

Hoe kan ik dit omzeilen, aangezien de cellen meestal wel allemaal geveuld zijn



ps.
Die inputboxen laat ik zo die hadden eigenlijks niets met dit stuk code te maken.
Dit stuk is een klein en vooralsnog missend deel van een macro welk ik op mijn werk gebruik.
Wat bij de inputboxes wordt ingegegeven wordt in meerdere documenten uitgevuld op verschillende plaatsen en wordt ook gebruikt voor het opslaan van de bestanden.



gr Robert

 

[robert123321]

Opgelost!

De foutnmelding heb ik er uit gekregen.
Mijn code is nu als volgt:

Sub Macro1()

Dim deleteRange As Range


 With Range("B4:B13")
        .Replace " ", ""
    On Error Resume Next
        Set deleteRange = .SpecialCells(xlCellTypeBlanks)
        deleteRange.EntireRow.Delete
    On Error GoTo 0
    
    End With
    
       
End Sub

Bedankt voor de hulp! :thumb:

 

[Wigi]

Die variabele kan er ook uit.

Sub Macro1()
    With Range("B4:B13")
        .Replace " ", ""
        On Error Resume Next
        .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End With
End Sub

PS: onthoud je van cross-posten, dat is niet netjes naar helpers toe Of doe jij graag dubbel werk.