• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

cel met elkaar vergelijken en ander kleur geven

Status
Niet open voor verdere reacties.
Wederom mijn dank voor het werk dat je eraan hebt:p

Getest en:
Als er na een update een nieuwe regel in sheet basis is gekomen omdat die nog niet bestond
dan word die met weer volgende updates niet meegenomen in kolom K met de oude getallen.

Ook merkte ik dat na een plak aktie van nieuwe data in sheet update deze niet zonder meer word meegenomen in in kolom K op sheet basis maar dat ik dan eerst in de sheet update in een cel moet staan en een keer op enter moet drukken.
 
Ik heb de update routine een klein beetje aangepast, omdat de currentregio door de lege kolom in de war werd gebracht
Die routine volg ik niet helemaal. Mogelijk omdat ik de precieze import gegevens niet ken.
Ik heb deze dan ook verder met rust gelaten.
De routine om de aangepast waarden te vinden heb ik aangepast en naar de worksheet_activate verplaatst.
Nu doet hij zijn werk iedere keer als je van het update naar het basis sheet gaat, ook na dus een na een update.
De kleur heb ik op blauw gezet. Oude wijzigen worden pas verwijderd als jij dat doet, of als je het sheet leeg maakt.
Hopelijk is dat wat je bedoelt.

Mvg Leo
 
Ik ben nu aan het testen en het ziet er tot nu toe goed uit.
Wat ik wel tegenkwam is dat na een eerste keer plakken van data in de uodate sheet en dan naar de basis gaat deze daar niet in verwerkt is.
het is dan natuurlijk zo dat ik er plak in de update sheet en daar verder niets doe. De "geplakte" sectie is dan dus nog aktief.
Als ik pas ergens in het tabblad heb geklikt worden de aanpassingen verwerkt in sheet basis.

Nogmaals alle bedankt voor de hulp dat hier verleent word, echt fantastich!! SHAPOO hoor,
 
Frank,
Ik heb het met een kleine range geprobeerd en toe ging het wel goed.
Een cel eerst selecteren voor het overschakelen is een goede
Komt de cel echter op tekstinvoer te staan (knipperende streep)dan voert excel geen enkele macro meer uit.

Nogmaals graag gedaan. Soms is het leuk wat dieper op een project in te duiken.
Elkaar helpen draait het om bij helpmij dacht ik zomaar...

Mvg Leo
 
Ik en er nu 2 dagen mee aan de gang en het bevalt mij erg goed, zo blij:D

Nog een vraagje:
Is het (vrij) simpel om de code zo aan te passen dat als de regel in de basis sheet niet meer voorkomt in de update deze word verwijderd?
Of word dat dan ook weer een "project" apart?:eek:
 
Mooi dat het goed bevalt.
Ik heb de macro hier niet bij de hand, maar het is geen probleem om op het eind een lus te laten lopen die kijkt of alle unike codes van het basis blad ook up het updateblad voorkomen en zo niet, dat dan het gebruikte dewl van de regel leegmaakt met ClearContents, niet de hele regel want dan gaat de formule in kolom T (dacht ik) eruit.
Vanvond kan ik daar zo nodig wel even naar kijken.

Mvg Leo
 
Leo,

Bedankt dat je er nog een keer naar wilt kijken.:thumb:
Echter als hij een regel leef maakt blijf je natuurlijk wel met lege regels zitten tussen alle andere data? Dat is misschien wel weer lastig.:eek:

Dit was de code die je tot nu toe had gemaakt.

Code: 
Private Sub Worksheet_Activate()
Dim iRij As Integer
Dim iTest As Integer
Dim sUniek As String
Dim iEinde As Integer
Dim iEinde2 As Integer
Dim c1 As Range
Dim c2 As Range
Dim r1 As Range
Dim r2 As Range

   On Error GoTo Worksheet_Change_Error
iEinde = 3 + Application.WorksheetFunction.CountA(Sheet1.Range("A4:A4000"))
iEinde2 = 3 + Application.WorksheetFunction.CountA(Sheet3.Range("A4:A4000")) 'stel het einde van de geïmporteerde lijst in.
If iEinde = 0 Or iEinde2 = 0 Then Exit Sub ' Verlaat de sub als het bereik leeg is.

Application.EnableEvents = False
Application.ScreenUpdating = False

Set r1 = Sheet1.Range("T4:T" & iEinde)
Set r2 = Sheet3.Range("B4:b" & iEinde2)
If Range("a4") = "" Then Exit Sub
        'Sheet1.Range("I4:I" & iEinde).Font.ColorIndex = 1 'reset de tekstkleur
For iRij = 4 To iEinde
sUniek = Sheet3.Cells(iRij, 2) & Sheet3.Cells(iRij, 8) 'combineer de unieke nummers
    If Application.WorksheetFunction.CountIf(r1, sUniek) > 0 Then 'is het uniek nummer aanwezig in het basissheet
            iTest = Application.WorksheetFunction.Match(sUniek, r1, 0) + 3 'zoek het rijnummer op
        Set c1 = Sheet1.Cells(iTest, 9)
        Set c2 = Sheet3.Cells(iRij, 9)
            If c2 <> c1 Then 'is de waarde ongelijk, dan;
            Sheet1.Cells(iTest, 11) = c1 'zet de oude waarde in K
            c1 = c2 'pas deze aan
            Sheet1.Cells(iTest, 11).Font.ColorIndex = 3
            c1.Font.ColorIndex = 3
         End If
    End If
Next iRij
'stel alles weer terug
Set c1 = Nothing
Set c2 = Nothing
Set r1 = Nothing
Set r2 = Nothing
Application.EnableEvents = True

Updaten

   On Error GoTo 0
   Exit Sub
'Foutafhandeling ===================================================================================================
Worksheet_Change_Error:
Application.EnableEvents = True
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Worksheet_Change of VBA Document Sheet3"
End Sub
 
Frank,
De lege regels worden weggesorteerd, daar merk je niets van.
Zie je inbox.

Mvg Leo
 
Wederom weer mijn hartelijke dank en ga er gelijk mee aan de slag, ik laat het hier weten.

Echter...(ik durf het bijna niet te zeggen/vragen)
Het blijkt nu dat het unieke nummer dat word aangemaakt op sheet basis in kolom T nog niet uniek genoeg is.
Het gebeurt namelijk wel eens dat er regels inkomen met dezelfde nummers uit de kolommen B en H maar een verschil in kolom L
Ik heb geprobeerd om de formule in kolom L aan te passen naar =B4&H4&L4 maar de uitkomst is dan bijv; 519439541263,0041666667 waarschijnlijk door de tijd in de cel met een dubbele punt?
gevolg is dat er dan niet geupdated word, is hier een oplossing voor?
 
Ja, ja, zo komt van het een het ander...:)


Met drie kolommen is ook goed te doen, dan moet er echter wel meer aangepast dan alleen de kolom.
Eerst maar even kijken hoe het huidige bestand werkt en of dat verder naar wens is.
Dan eventuele verdere wensen en aanpassingen inventariseren en kijken wat uitvoerbaar is.
Althans dat is mijn voorstel.
Zo voorkom je dat er zaken worden uitgevoerd, die later onnodig blijken of anders moesten.
We lezen dat graag

Mvg Leo
 
Leo.

Laatste versie van het bestand doet goed wat die moet doen maar je hebt gelijk eerst de "huidige" kinderziekte oplossen.:p
En dat is:
Het gebeurt regelmatig op het begin van de nieuwe dag dus als ik met en nieuw leeg bestand begin en na een uur een update plak in de update sheet dat de macro niet werkt.
Als ik dan eerst een andere macro (bijv. macro updaten dmv de knop) doe dan werkt daarna wel de aanpassingen in de cellen en de regels verwijderen.
Heel vreemd, ik kan er geen vinger op leggen hoe dit komt:eek:
 
Zo, inmiddels al weer een paar weken aan de gang met het bestand en het werkt nog steeds naar behoren.
Ik heb zelf wat aanpassingen kunnen doen om het nog meer naar de zin de maken.

Het enige waar ik nu nog tegenaan loop is dat ik graag zou willen dat ook de kolommen L t/m Q geupdated worden in de eerste sheet.

Nu word onderstaande code gebruikt.(met dank aan leofact)

Code: 
Private Sub Worksheet_Activate()
'Als tabblad update leeg is word schakelen naar tabblad Basis geblokkeerd.

Application.ScreenUpdating = False
    If WorksheetFunction.CountBlank(Sheets(2).Range("A4:Q10")) = 119 Then
      Sheets(2).Activate
       MsgBox (" Als dit werkblad leeg is kan en moet je niet schakelen naar ander tabblad.")
        Exit Sub
    End If
  Application.ScreenUpdating = True

'----------------------------

Dim iRij As Integer
Dim Rij As Integer
Dim iTest As Integer
Dim sUniek As String
Dim iEinde As Integer
Dim iEinde2 As Integer
Dim c1 As Range
Dim c2 As Range
Dim r1 As Range
Dim r2 As Range

   On Error GoTo Worksheet_Change_Error

iEinde = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row 'stel het einde van de babis range in.
iEinde2 = 3 + Application.WorksheetFunction.CountA(Sheet3.Range("A4:A4000")) 'stel het einde van de ge�mporteerde lijst in.
If iEinde = 0 Or iEinde2 = 0 Then Exit Sub ' Verlaat de sub als het bereik leeg is.

Application.EnableEvents = False
Application.ScreenUpdating = False

Set r1 = Sheet1.Range("T4:T" & iEinde)
Set r2 = Sheet3.Range("B4:b" & iEinde2)
If Range("a4") = "" Then Exit Sub
        'Sheet1.Range("I4:I" & iEinde).Font.ColorIndex = 1 'reset de tekstkleur
For iRij = 4 To iEinde 'zoek net meer bestaande rijen
    For Rij = 4 To iEinde2
        If Sheet1.Range("T" & iRij) = Sheet3.Range("B" & Rij) & Sheet3.Range("H" & Rij) Then Exit For
    Next Rij
 If Rij = iEinde2 + 1 Then Sheet1.Range("A" & iRij, "S" & iRij).ClearContents 'weg ermee
sUniek = Sheet3.Cells(iRij, 2) & Sheet3.Cells(iRij, 8) 'combineer de unieke nummers
    If Application.WorksheetFunction.CountIf(r1, sUniek) > 0 Then 'is het uniek nummer aanwezig in het basissheet
            iTest = Application.WorksheetFunction.Match(sUniek, r1, 0) + 3 'zoek het rijnummer op
        Set c1 = Sheet1.Cells(iTest, 9)
        Set c2 = Sheet3.Cells(iRij, 9)
            If c2 <> c1 Then 'is de waarde ongelijk, dan;
            Sheet1.Cells(iTest, 11) = c1 'zet de oude waarde in K
            c1 = c2 'pas deze aan
            Sheet1.Cells(iTest, 11).Font.ColorIndex = 3
            c1.Font.ColorIndex = 3
         End If
    End If
Next iRij
Sheet1.Range("A4:Z" & iEinde).Sort Sheet1.Range("a4")
'stel alles weer terug
Set c1 = Nothing
Set c2 = Nothing
Set r1 = Nothing
Set r2 = Nothing
Application.EnableEvents = True

Updaten

   On Error GoTo 0
   Exit Sub
'Foutafhandeling ===================================================================================================
Worksheet_Change_Error:
Application.EnableEvents = True
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Worksheet_Change of VBA Document Sheet3"
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan