Automatische zoeken en aanpassen met macro's

[SHekkens]

Hoi,

Ik ben al een tijdje aan het vogelen met macro's en ik moet een artikel nummer toevoegen aan een handeling, dit moet in een macro komen.
In de bijlage is een voorbeeld te vinden.

De handeling dat een artikel nummer moet krijgen is Transport/CC Karren
voorbeeld artikel nummer is 12345678910 dit komt in de voor gelegen kolom 'Product ID'
Vervolgens blijven de kolommen RSP ID, Fust ID en Fust omschrijving leeg.
In de Kolommen Aantal fust, inhoud en aantal stuks komt 1 in te staan.
Als laatste moet de inhoud van de kolom 'Verkoop bedrag' worden gewist.

Alvast bedankt

Sjoerd

 

[Warme bakkertje]

Voor zover ik je uitleg begrijp

Sub tst()
On Error Resume Next
With Sheets("Blad1").Columns(8).Find(InputBox("Geef ID-nummer"), , xlValues, xlWhole)
    .Offset(, 2).Resize(, 3).ClearContents
    .Offset(, 5).Resize(, 3) = 1
    .Offset(, 11).ClearContents
End With
End Sub

 

[SHekkens]

Denk dat het in de buurt komt, maar ik denk dat mijn vraag niet goed geformuleerd is.

In de sheet staat Transport/CC Karren nog zonder artikel nummer (Product ID), deze moet dus nog worden toegewezen. En er staan meerderen Transporten in een sheet

(En in de lege cellen in de kolommen Fust aantal, inhoud en Aantal stuks moet '1' in komen te staan. De cel in kolom Verkoop bedrag dient gewist te worden.)

Maar dat zit er al in, voor zo ver ik de code kan lezen.

 

[Warme bakkertje]

Komt er voor elk Transport een nieuw ID-nummer of steeds hetzelfde ?

 

[SHekkens]

Transport/CC Karren krijgt een vast ID-nummer.

 

[SHekkens]

*kick*

 

[SHekkens]

Ik heb nu dit:

Sub TransportTest()
On Error GoTo Einde
Do
With Sheets("Product").Columns(7).Find("Transport/CC Karren", LookIn:=xlValues, LookAt:=xlWhole)
.Offset(, 1) = "123456789"
.Offset(, 2) = "Transport"
.Offset(, 3).Resize(, 3).ClearContents
.Offset(, 6).Resize(, 3) = 1
.Offset(, 12).ClearContents
End With
Loop Until Err.Number = 0
Einde:
End Sub

Probleem is dat hij stopt na de eerste Transport/CC Karren. In dit geval rij 41 terwijl er nog drie andere Transport/CC Karren in staan

 

[Warme bakkertje]

Sub TransportTest()
With Sheets("Product").Range("G1:G351")
    Set c = .Find("Transport/CC Karren", LookIn:=xlValues, LookAt:=xlWhole)
    If Not c Is Nothing Then
    firstaddress = c.Address
    Do
        c.Offset(, 1) = "123456789"
        c.Offset(, 2) = "Transport"
        c.Offset(, 3).Resize(, 3).ClearContents
        c.Offset(, 6).Resize(, 3) = 1
        c.Offset(, 12).ClearContents
        Set c = .FindNext(c)
    Loop While Not c Is Nothing And c.Address <> firstaddress
    End If
End With
End Sub

 

[SHekkens]

Dankjewel, het werkt perfect!!!!!!