Hey MollyVH,

Bedankt voor dit mooie code-blokje.
Bij het uitvoeren kreeg ik op de msgbox "3,90625E-03 sec." en toen ik op het werkblad "patroon" ging kijken was er bij geen enkele volledige groene rij een "x" geplaatst...

Uiteraard ben ik sinds mijn laatste post niet gestopt met brainstormen terwijl ik aan het borduren was en toen bedacht ik dat mijn initieel idee (om de afgewerkte cellen te tellen) niet nodig was op beide werkbladen en dus beperkt kon worden op het werkblad "afgewerkt" waarbij ik wél via een formule kon tellen, nl de AANTAL.ALS formule op basis van de waarde " " (spatie).
Ik heb dit dan eens uitgetest door vervolgens met 2 kleine loops die "hulp-kolom" op werkblad "afgewerkt"  te doorlopen om het begin en einde te bepalen volgens het aantal dat vermeld werd.
Als ik met die kleine toevoeging dan mijn macro laat lopen (heb er ook eventjes die twee lijntjes code ivm timer aan toegevoegd) dan kreeg ik op de msgbox "0,21875 sec." te zien.

Doordat na jouw macro te laten lopen die "x" niet geplaatst word en er dus waarschijnlijk ergens iets mis gaat vermoed ik dat dat de reden is dat de timer bij jouw macro op bijna 4 sec staat?


groetjes,
BlackDevil

Hey MollyVH,

Ik denk dat ik de oorzaak ivm het kruisje heb gevonden.
In mijn origineel bestand voer ik de macro ‘afgwerkt’ altijd uit wanneer het werkblad “afgewerkt” actief staat zodat ik onmiddellijk het resultaat kan zien. Toen ik jouw macro ging testen stond dus ook het werkblad “afgewerkt” actief en werden de kruisjes niet geplaatst.
Ik heb dan jouw macro eens uitgetest toen het werkblad “patroon” actief stond en toen werden de kruisjes wel vermeld nadat ik de msgbox sloot.
PS : Bij de laatste test klokte de timer in jouw macro wel nog steeds af op “2,0625 sec.”

Ivm al dan niet een meerwaarde te zijn om de spaties te noteren (en tellen) veranderen de aantallen inderdaad naarmate het borduurwerk vordert maar aangezien er via een formule geteld word, word dit automatisch aangepast na elke bijwerking waardoor bij de volgende bijwerking de variabelen ‘begin’ en ‘einde’ automatisch het correcte (nieuwe) rijnummer hebben om de loop te starten.

Ik ga nog eventjes beide macro’s blijven vergelijken mbt snelheid naargelang het borduurwerk vordert zodat ik kan ondervinden welke praktisch gezien het snelst en handigste werkt.

Ontzettend hard bedankt voor jouw input en de tijd die je er hebt ingestoken, ik heb zeer veel nuttigs bijgeleerd alweer.


Groetjes,
BlackDevil

Wat vind je van deze macro (zie bijlage), hij doet alles (met veel meer data) in 0,1 seconde 

Als je macro "jec" vervangt door onderstaande zou het opgelost moeten zijn. 1 regeltje extra doet de truc

Sub jec()
 Set ar = Sheets(1).ListObjects(1).DataBodyRange
 Set sht = Sheets("Afgewerkt")
 
 Application.ScreenUpdating = False
 Sheets("patroon").UsedRange.Copy Sheets("Afgewerkt").Range("A1")
 
 No_Borders
 
 For Each it In ar.Columns(6).Cells
   With Application.FindFormat
     .Clear
     .Font.Name = it.Font.Name
     .Interior.Color = vbGreen
   End With
   
   With Application.ReplaceFormat
     .Clear
     With .Borders
       For Each sp In Array(xlDiagonalUp, xlDiagonalDown)
          .Item(sp).Color = RGB(it.Offset(, -4), it.Offset(, -3), it.Offset(, -2))
          .Item(sp).LineStyle = xlContinuous
          .Item(sp).Weight = 4
       Next
     End With
   End With
   Sheets("Afgewerkt").UsedRange.Replace it, "", SearchFormat:=True, ReplaceFormat:=True
 Next

 sht.UsedRange.Interior.Pattern = xlNone
 sht.UsedRange.ClearContents
End Sub

De code blijft snel omdat er naast het aflopen van de rijen op het eerste tabblad, geen loops in zitten.

Formatting wordt direct benaderd via find en replaceformat

@ JEC,

Mooie en simpele code 
Dat gaat zo met wie 100% autodidact is, men mist al eens iets... ik was nooit eerder Find- of ReplaceFormat tegengekomen, zal zeker nog van pas komen.

Juist omdat het zo zelden gebeurt is het extra leuk als ik jou eens iets kan bijbrengen (al is het hier iets heel simpel).
Als we de diagonalen buiten beschouwing laten zijn er 6 mogelijke randen. Als die alle 6 dezelfde behandeling nodig hebben volstaat 1 instructie.
Dus:
     With Sheets("Afgewerkt").Cells
          .Borders(xlEdgeLeft).LineStyle = xlNone
          .Borders(xlEdgeTop).LineStyle = xlNone
          .Borders(xlEdgeBottom).LineStyle = xlNone
          .Borders(xlEdgeRight).LineStyle = xlNone
          .Borders(xlInsideVertical).LineStyle = xlNone
          .Borders(xlInsideHorizontal).LineStyle = xlNone
     End With

kan ook zo:
Sheets("Afgewerkt").Cells.Borders.LineStyle = xlNone
Mvg,
Molly

*update*

Omdat ik nog een andere macro heb die afhankelijk is van de waarde “ “ (spatie), in de cellen die gekleurde diagonale borders hebben, heb ik de macro van JEC lichtjes aangepast en er ook meteen de aanpassing van MollyVH mbt de ‘no borders’ aan toegevoegd met onderstaande macro als eindresultaat.

Sub afgewerkt()
 Set ar = Sheets("DMCtoRGB").ListObjects(1).DataBodyRange
 Set sht = Sheets("afgewerkt")
 
 Application.ScreenUpdating = False
 Sheets("patroon").UsedRange.Copy Sheets("afgewerkt").Range("A1")
 
 Sheets("afgewerkt").Cells.Borders.LineStyle = xlNone
'  t = Timer

 For Each it In ar.Columns(6).Cells
   With Application.FindFormat
     .Clear
     .Font.Name = it.Font.Name
     .Interior.Color = vbGreen
   End With
   
   With Application.ReplaceFormat
     .Clear
     With .Borders
       For Each sp In Array(xlDiagonalUp, xlDiagonalDown)
          .Item(sp).Color = RGB(it.Offset(, -4), it.Offset(, -3), it.Offset(, -2))
          .Item(sp).LineStyle = xlContinuous
          .Item(sp).Weight = 4
       Next
     End With
   End With
   Sheets("afgewerkt").UsedRange.Replace it, " ", SearchFormat:=True, ReplaceFormat:=True
 Next

sht.UsedRange.Interior.Pattern = xlNone
sht.UsedRange.Font.Color = vbWhite
'  MsgBox Format(Timer - t, "0.00\s")

End Sub
PS : Ik heb de font.color van de sht.UsedRange gewoon op vbWhite gezet (ipv een volledige ClearContents toe te passen) omdat ik niet meteen vond hoe ik enkel de cellen met een symbool moest leegmaken.

Hartelijk dank aan JEC en MollyVH voor jullie aangereikte oplossingen, ik heb er weer héél wat van bijgeleerd ;-).

Groetjes,
BlackDevil