er waren in mijn rekenblad teveel fouten...
deze code bleek de oplossing te zijn:
(met een aantal correcties die nodig waren omdat een zeker aantal cellen foutievelijk ingevuld waren zoals bvb een ; ipv een . tussen de cijfers ed)
Private Sub RenumberColumnLOnBothSheets()
Application.ScreenUpdating = False
Pos1 = 1
ShtNmLstPrt = " Competenties"
ShtNm = "BGV"
For Sht = 1 To 2
Dim cl As Range
With Sheets(ShtNm & ShtNmLstPrt)
.Protect Password:="Aanpassen", UserInterfaceOnly:=True
For Each cl In .Range("L6:L" & .[L65536].End(xlUp).Row)
If cl > 0 Then
cl.NumberFormat = "@"
cl = Replace(cl, ",", ".")
cl = Replace(cl, ";", ".")
cl = Trim(cl)
For Length = 1 To 6
Pos2 = InStr(Pos1, cl, ".", vbTextCompare)
If Pos2 = 0 Then
If Len(cl) < 2 Then
cl = "0" & cl
ElseIf Len(cl) - (Pos1 - 1) = 1 And Length <> 4 Then
cl = Left(cl, (Pos1 - 1)) & "0" & Right(cl, Len(cl) - (Pos1 - 1))
ElseIf Len(cl) - (Pos1 - 1) = 1 And ShtNm = "BGV" Then
cl = Left(cl, (Pos1 - 1)) & "0" & Right(cl, Len(cl) - (Pos1 - 1))
ElseIf Len(cl) - (Pos1 - 1) = 1 And ShtNm = "GASV" And Length = 4 Then
cl = Left(cl, (Pos1 - 1)) & "00" & Right(cl, Len(cl) - (Pos1 - 1))
ElseIf Len(cl) - (Pos1 - 1) = 2 And ShtNm = "GASV" And Length = 4 Then
cl = Left(cl, (Pos1 - 1)) & "0" & Right(cl, Len(cl) - (Pos1 - 1))
End If
Exit For
End If
If Pos2 - Pos1 = 1 And Length <> 4 Then
If Left(cl, 1) >= Chr(65) Then
If Length > 1 Then
cl = Left(cl, (Pos1 - 1)) & "0" & Right(cl, Len(cl) - (Pos1 - 1))
Pos2 = Pos2 + 1
End If
Else
cl = Left(cl, (Pos1 - 1)) & "0" & Right(cl, Len(cl) - (Pos1 - 1))
Pos2 = Pos2 + 1
End If
End If
If Pos2 - Pos1 = 1 And ShtNm = "BGV" Then
If Left(cl, 1) >= Chr(65) Then
If Length > 1 Then
cl = Left(cl, (Pos1 - 1)) & "0" & Right(cl, Len(cl) - (Pos1 - 1))
Pos2 = Pos2 + 1
End If
Else
cl = Left(cl, (Pos1 - 1)) & "0" & Right(cl, Len(cl) - (Pos1 - 1))
Pos2 = Pos2 + 1
End If
End If
If Pos2 - Pos1 = 2 And ShtNm = "GASV" And Length = 4 Then
If Left(cl, 1) >= Chr(65) Then
cl = Left(cl, (Pos1 - 1)) & "0" & Right(cl, Len(cl) - (Pos1 - 1))
Pos2 = Pos2 + 1
Else
cl = Left(cl, (Pos1 - 1)) & "0" & Right(cl, Len(cl) - (Pos1 - 1))
Pos2 = Pos2 + 1
End If
End If
If Pos2 - Pos1 = 1 And ShtNm = "GASV" And Length = 4 Then
If Left(cl, 1) >= Chr(65) Then
cl = Left(cl, (Pos1 - 1)) & "00" & Right(cl, Len(cl) - (Pos1 - 1))
Pos2 = Pos2 + 1
Else
cl = Left(cl, (Pos1 - 1)) & "00" & Right(cl, Len(cl) - (Pos1 - 1))
Pos2 = Pos2 + 1
End If
End If
Pos1 = Pos2 + 1
Next Length
Pos1 = 1
End If
Next cl
End With
ShtNm = "GASV"
Next Sht
Application.ScreenUpdating = True
End Sub
