Hurtigere makro

Hvilken nedenstående kode???

Anyway, måske du kan finde hjælp her:
http://www.EXCELGAARD.dk/Bib/CPR/

Hvis du har CPR-nummerne stående i f.eks. celle A1 til A2000, og ønsker fødselsdagene i cellerne B1 til B2000, vil koden kunne se således ud:

For Counter = 1 to 2000
  Range("B" & Counter).Value = CPR(Range("A" & Counter).Value, 4)
Next

Nå ja, jeg skal måske huske at indsætte koden ;-)

Beklager. Her er den:

Sub CprTilDato()
Dim bytCent As Byte
Dim bytSevdig As Byte
Dim bytCprYear As String
Dim CprTilDato As Date

For Each c In Selection.Cells
  If Len(cpr) = 11 Then
      bytSevdig = Mid(c.Value, 8, 1)
  Else
      bytSevdig = Mid(c.Value, 7, 1)
  End If
       
  bytCprYear = Mid(c.Value, 5, 2)
   
  Select Case bytSevdig
      Case 0 To 3
          bytCent = 19
      Case 4, 9
          If bytCprYear <= 36 Then
              bytCent = 20
          Else
              bytCent = 19
          End If
      Case 5 To 8
          If bytCprYear <= 36 Then
              bytCent = 20
          ElseIf bytCprYear >= 58 Then
              bytCent = 18
          End If
      End Select
    CprTilDato = Mid(c.Value, 3, 2) & "-" & Left(c.Value, 2) & "-" & bytCent & bytCprYear
    c.Offset(0, 1) = Format(CprTilDato, "dd-mm-yyyy")
Next c
End Sub

Hvis du indsætter følgende i starten af din kode:

ActiveSheet.DisplayPageBreaks = False
With Application
      .Cursor = xlWait
      .EnableEvents = False
      .ScreenUpdating = False
      .Calculation = xlCalculationManual
End With

...og dernæst følgende i slutningen af din kode

With Application
      .Calculation = xlCalculationAutomatic
      .ScreenUpdating = True
      .EnableEvents = True
      .Cursor = xlDefault
End With

...så tager det ca. 1 sekund, at køre koden på 65.536 rækker med CPR-numre på min PC med Excel 2003.

Læs mere om, at sætte hastigheden op på dine makroer her:
http://www.EXCELGAARD.dk/Lib/Macros/SpeedUp/

Det gjorde underværker. Tak for hjælpen!

Velbekomme :-)