Waarde in cell zoeken en rij invoegen

[MEradus]

Hallo,

Ik ben bezig om rapportage met vba om te bouwen.

Nu stuiter ik op een probleempje.

Nu heb ik in kolom aan 3 type voertuigen staan, namelijk OV, RST, Caddy en Taxi.
Het zou zo moeten zijn dat hij zoekt naar bijvoorbeeld de laatste 'OV' en daaronder een regel invoegd.
En dat ook voor RST en Caddy. Taxi is niet nodig omdat die al goed staat.

Zou iemand mij hiermee kunnen helpen.

Voor de zekerheid heb ik een voorbeeld bestandje erbij gedaan.
Alvast bedankt voor het kijken.



Groeten Michel

Bekijk bijlage voorbeeldbestandje.xls.xlsx

 

[HSV]

Test het eens.

Sub hsv()
Dim i As Long, a As Variant, c As Range, firstaddress As String, Doaddress As String
For i = 0 To 2
  a = Array("OV", "RST", "Caddy")
With Sheets("Blad1").Columns(1)
  Set c = .Find(a(i), , xlValues, xlWhole)
    If Not c Is Nothing Then
   firstaddress = c.Address
Do
   c.Value = a(i)
     Set c = .FindNext(c)
  If c.Address > firstaddress Then Doaddress = c.Address
Loop While Not c Is Nothing And c.Address <> firstaddress
     Range(Doaddress).Offset(1).EntireRow.Insert
    End If
  End With
 Next
End Sub

 

[MEradus]

Bedankt.

Heb hem zojuis getest en het werkt zoals het zou moeten!

Groeten Michel

 

[MEradus]

Hoi Harry,

Zou de range ook iets opgerekt kunnen worden?
Ik heb er namelijk ook een dag bij dat ik ipv 2, 5 'OV' heb. En dan zet de macro er tussen de OV's ook een extra rij.
En ik heb al geprobeerd om iets aan te passen, maar dat lukt me op een of andere manier niet.

Alvast bedankt voor het kijken

Groeten Michel

 

[HSV]

Graag een nieuw bestandje uploaden Michel.
Ik heb geen flauw idee hoe ik me het moet voorstellen.

 

[MEradus]

Harry,

Hierbij het nieuwe bestandje.

Het 'oude' was gebasseerd op 2 regels waar "OV" in stond.
En dit zou eigenlijk naar 5 moeten.

Alvast bedankt voor het kijken.

Gr Michel

Bekijk bijlage voorbeeldbestandje2.xlsx

Ps. Omdat ik nog een beginner ben met vba, zou het mogelijk zijn dat je me een kleine uitleg geeft van de code. Misschien kan ik het dan voor mezelf plaatsen en de volgende keer zelf toevoegen. Als je dat liever niet doet is er natuurlijk geen man overboord.

 

[HSV]

Hierbij een hernieuwde versie met enig uitleg Michel.

Sub hsv()
Dim i As Long, a As Variant, c As Range, firstaddress As String, Doaddress As String
For i = 0 To 2                                               'loop 3 x van 0 t/m 2
  a = Array("OV", "RST", "Caddy")                     'alle gezochte namen
With Sheets("Blad1").Columns(1)
  Set c = .Find(a(i), , xlValues, xlWhole)            'zoek de 1e naam uit de array  = a(i) = a(OV) bij de tweede next a(RST)
    If Not c Is Nothing Then                             'als niet gevonden ga naar next
   firstaddress = c.Address                              'adres van gevonden opslaan als eerste adres
Do                                                              'loop
   c.Value = a(i)                                            
     Set c = .FindNext(c)                                 'zoek de volgende cel als die bestaat
  If c.Row > Range(firstaddress).Row Then Doaddress = c.Address     'als de gevonden rij groter is dan de eerste dan DoAddress wordt adres
Loop While Not c Is Nothing And c.Address <> firstaddress               'loop net zolang tot door tot het niets meer vindt
     Range(Doaddress).Offset(1).EntireRow.Insert                           'voeg een lege regel toe onder de laatst gevonden
    End If
  End With
 Next
End Sub

 

[MEradus]

Bedankt Harry,

Ik ga het morgen gelijk testen!

Gr Michel

 

[HSV]

En, heeft de code de test doorstaan?

 

[MEradus]

Hoi Harry!

Zeker weten! Hij werkt precies zoals ik hoopte!
Bedankt voor je hulp en de uitleg was heel duidelijk dank je wel!

Gr Michel

 

[MEradus]

Hoi Harry,
Toch nog een vraagje.
Zou je me ook kunnen vertellen hoe het kan dat als er geen 5 maar bijvoorbeel 1 of 2 regels met 'OV' hebt staan, waarom de macro dan niet werkt? ( global_range fout)
En is dit op een makkelijke manier op te lossen?

Ik hoop dat mijn vraagstelling duidelijk is.

Gr Michel

 

[HSV]

Mijn excuses Michel, ik had het niet goed getest.

Sub hsv()
Dim i As Long, a As Variant, c As Range, firstaddress As String, Doaddress As String
For i = 0 To 2                                               'loop 3 x van 0 t/m 2
  a = Array("OV", "RST", "Caddy")                     'alle gezochte namen
With Sheets("Blad1").Columns(1)
  Set c = .Find(a(i), , xlValues, xlWhole)            'zoek de 1e naam uit de array  = a(i) = a(OV) bij de tweede next a(RST)
    If Not c Is Nothing Then                             'als niet gevonden ga naar next
   firstaddress = c.Address                              'adres van gevonden opslaan als eerste adres
Do                                                              'loop
   c.Value = a(i)
     Set c = .FindNext(c)                                 'zoek de volgende cel als die bestaat
  If c.Row > Range(firstaddress).Row Then Doaddress = c.Address     'als de gevonden rij groter is dan de eerste dan DoAddress wordt adres
Loop While Not c Is Nothing And c.Address <> firstaddress               'loop net zolang tot door tot het niets meer vindt
     If Doaddress <> "" Then
        Range(Doaddress).Offset(1).EntireRow.Insert
      Else
     c.Offset(1).EntireRow.Insert 'voeg een lege regel toe onder de laatst gevonden
      End If
    End If
  End With
 Next
End Sub

 

[MEradus]

Geen excuus nodig, ben al erg blij met de hulp