code werk niet in mijn werkblad, wel in een nieuw!

[don42]

helemaal trots op hetgeen wat ik weliswaar met heel veel hulp in elkaar gezet heb
wil ik het gaan "inbouwen" in mijn file
Ik heb volgende code

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
K = Selection.Column
If K <= 11 Then
On Error Resume Next
If Not Application.Intersect(Cells(12, K), Target) Is Nothing Then
 tel = WorksheetFunction.Count(Blad2.Range(Cells(2, K), Cells(11, K)))
 eindtel = 0 - tel
  If tel = 0 Then Response = MsgBox("Je hebt nog niets ingevoerd. ", vbQuestion + vbOKOnly, "Spaarkas de Donderie " & Cells(1, K)): Exit Sub
  If tel = 0 Then Response = MsgBox("Je moet nog van " & eindtel & vbNewLine & "Kas(sen) de bedragen invullen. ", vbQuestion + vbOKOnly, "Spaarkas de Donderie " & Cells(1, K)): Exit Sub
   Response = MsgBox("De weekinvoer is " & Format(WorksheetFunction.Sum(Blad2.Range(Cells(2, K), Cells(11, K))), "€ ##,##0.00") & vbNewLine & "Controleer dit met je eigen gegevens. ", vbQuestion + vbYesNo, "Spaarkas de Donderie " & Cells(1, K))
If Response = vbNo Then
Application.Goto Cells(2, K): Exit Sub
Else
Application.Goto Sheets("Blad3").Cells(Rows.Count, 1).End(xlUp).Offset(1): Exit Sub
End If
End If
End If
End Sub

dit heb ik met heel wat hulp gemaakt
als ik het nu de code in mijn uiteindelijke werkblad invoeg werkt het niet
zelfs niet als ik een leeg blad toevoeg met enkel bovenstaande code,

er zit dus een conflict in mijn werkblad, iemand een tip om uit te zoeken waar de eventuele fout zit

Don
Bekijk bijlage tellen3.xlsm

 

[VenA]

Ja, Jouw werkblad bijvoegen met de code!

 

[snb]

En verander meteen even de titel van je bericht.

 

[don42]

Hoe moet ik een file versturen
die erg groot is
De file waar ik de code wil invoeren is te groot (veel te grrot) om te versturen 1.5 mb

don

 

[edmoor]

Haal eerst eens die On Error Resume Next eruit. Die zorgt ervoor dat wanneer zich een fout voordoet, de macro gewoon doorgaat en je geen idee hebt waar het misgaat als je dat niet netjes afhandeld. Laat hier vervolgens weten welke foutmelding je krijgt.

Tevens heb je er 2x If tel = 0 in staan waarbij als de eerste waar is de Sub verlaten wordt. De tweede wordt dus voor zover ik kan zien nooit uitgevoerd.

Daarnaast maak je met juiste inspringpunten de code een stuk leesbaarder, zoals hier:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
K = Selection.Column
If K <= 11 Then
    On Error Resume Next
    If Not Application.Intersect(Cells(12, K), Target) Is Nothing Then
	tel = WorksheetFunction.Count(Blad2.Range(Cells(2, K), Cells(11, K)))
	eindtel = 0 - tel
	If tel = 0 Then Response = MsgBox("Je hebt nog niets ingevoerd. ", vbQuestion + vbOKOnly, "Spaarkas de Donderie " & Cells(1, K)): Exit Sub
	If tel = 0 Then Response = MsgBox("Je moet nog van " & eindtel & vbNewLine & "Kas(sen) de bedragen invullen. ", vbQuestion + vbOKOnly, "Spaarkas de Donderie " & Cells(1, K)): Exit Sub
	Response = MsgBox("De weekinvoer is " & Format(WorksheetFunction.Sum(Blad2.Range(Cells(2, K), Cells(11, K))), "€ ##,##0.00") & vbNewLine & "Controleer dit met je eigen gegevens. ", vbQuestion + vbYesNo, "Spaarkas de Donderie " & Cells(1, K))
	If Response = vbNo Then
	    Application.Goto Cells(2, K): Exit Sub
	Else
	    Application.Goto Sheets("Blad3").Cells(Rows.Count, 1).End(xlUp).Offset(1): Exit Sub
	End If
    End If
End If
End Sub

Hier heb ik dus alleen de inspringpunten veranderd voor de leesbaarheid. Hij zal nog steeds niet werken.

 

[don42]

Bedankt voor je reactie

Om te binnen die twee nullen is idd een domme fout
maar ik had wat gespeeld met de code om te zien of dat verschil uit zou maken en niet terug gezet
erg slordig
Bekijk bijlage tellen3.xlsm
bovenstaand bestandje werkt wel degelijk
Maar als ik het nu in een ander Excel bestand van mij wil gebruiken dan werkt het niet
krijg geen foutmelding maar de msgbox met de melding dat er nog niets is ingevuld (uiteraard is dat wel het geval)

zelfs als ik een nieuw tabblad aanmaak en noem dat Blad2 (exact het zelfde als in de file van de bijlage)
wil het niet werken

mijn code

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
K = Selection.Column
If K <= 11 Then
On Error Resume Next
If Not Application.Intersect(Cells(12, K), Target) Is Nothing Then
 tel = WorksheetFunction.Count(Blad2.Range(Cells(2, K), Cells(11, K)))
 eindtel = 10 - tel
  If tel = 0 Then Response = MsgBox("Je hebt nog niets ingevoerd. ", vbQuestion + vbOKOnly, "Spaarkas de Donderie " & Cells(1, K)): Exit Sub
  If tel <> 10 Then Response = MsgBox("Je moet nog van " & eindtel & vbNewLine & "Kas(sen) de bedragen invullen. ", vbQuestion + vbOKOnly, "Spaarkas de Donderie " & Cells(1, K)): Exit Sub
   Response = MsgBox("De weekinvoer is " & Format(WorksheetFunction.Sum(Blad2.Range(Cells(2, K), Cells(11, K))), "€ ##,##0.00") & vbNewLine & "Controleer dit met je eigen gegevens. ", vbQuestion + vbYesNo, "Spaarkas de Donderie " & Cells(1, K))
If Response = vbNo Then
Application.Goto Cells(2, K): Exit Sub
Else
Application.Goto Sheets("Blad3").Cells(Rows.Count, 1).End(xlUp).Offset(1): Exit Sub
End If
End If
End If
End Sub

Wie kan me verder helpen?
zoals al geschreven de file waar ik het graag werkend had is erg groot om te versturen


Don

 

[don42]

Als ik de On Error resume Next weg haal
dan krijg ik deze regel geel: tel = WorksheetFunction.Count(Blad2.Range(Cells(2, K), Cells(11, K)))
dus daar zit iets fout maar wat en waarom niet in de file tellen3 uit de bijlage?

 

[don42]

Ik heb het gevonden:
tel = WorksheetFunction.Count(Range(Cells(2, K), Cells(11, K))) was de oplossing.

iedereen bedankt voor de hulp en het mee denken

Don