Solved: Program is slow

Hello there I am a beginner i VBA

I made the program below it works but is very slow.
The copy below is just a part of the program the pice below is repeated
15 times

The program selects data from excel sheets and sorts it for a printform

[VBA]Private Sub CmdBtn5_Click()
Application.ScreenUpdating = False

'vult de waardes van de twee comboboxen in printliste
Sheets("Printliste").Range("I1").Value = Cboaggtype1.Value
Sheets("Printliste").Range("J1").Value = Cbomodnr1.Value

'delete empty rows and sort on col.A duplicate and col.B duplicate
'then sum in col.C and delete lowest duplicate
Dim xrow As Integer
Dim K As Integer
Dim j As Integer
Dim A As String
Dim B As String
Dim C As Integer
Dim i As Integer

'selecteer de data in kolom B tm F (Hatt)
'Copy named range to somewhere ("A200")
Sheets("Deleliste").Range("B1:F29").Copy Range("A200")
Range("A200").Select
If Range("A201") <> "" Then
Selection.End(xlDown).Select
End If
'check 200 rows of named range and delete empty rows
For i = 400 To 200 Step -1
If Cells(i, "A") = "" Then
'Is blank
Cells(i, "A").EntireRow.Delete
End If
Next i
'check for duplicate value's col.A and B sum duplicates in col.C and delete lowest duplicate row
xrow = ActiveCell.Row
Range("A202").Select
For K = 1 To xrow
If ActiveCell.Value <> "" Then
A = ActiveCell.Value
B = ActiveCell.Offset(0, 1).Value
C = ActiveCell.Offset(0, 2).Value
For j = 1 To xrow
If ActiveCell.Offset(j, 0).Value = A Then
If ActiveCell.Offset(j, 1).Value = B Then
C = C + ActiveCell.Offset(j, 2).Value
ActiveCell.Offset(0, 2).Value = C
ActiveCell.Offset(j, 0).EntireRow.Delete
j = j - 1
End If
End If
Next j
ActiveCell.Offset(1, 0).Select
End If
Next K
'copy the selected data to the printliste
Range("A200:D300").Copy Sheets("Printliste").Range("A6")
Sheets("Deleliste").Select

'selecteer de data in kolom G tm K (Hatt deling)
'Copy named range to somewhere ("A200")
Sheets("Deleliste").Range("G1:K29").Copy Range("A200")
Range("A200").Select
If Range("A201") <> "" Then
Selection.End(xlDown).Select
End If
'check 200 rows of named range and delete empty rows
For i = 400 To 200 Step -1
If Cells(i, "A") = "" Then
'Is blank
Cells(i, "A").EntireRow.Delete
End If
Next i
'check for duplicate value's col.A and B sum duplicates in col.C and delete lowest duplicate row
xrow = ActiveCell.Row
Range("A202").Select
For K = 1 To xrow
If ActiveCell.Value <> "" Then
A = ActiveCell.Value
B = ActiveCell.Offset(0, 1).Value
C = ActiveCell.Offset(0, 2).Value
For j = 1 To xrow
If ActiveCell.Offset(j, 0).Value = A Then
If ActiveCell.Offset(j, 1).Value = B Then
C = C + ActiveCell.Offset(j, 2).Value
ActiveCell.Offset(0, 2).Value = C
ActiveCell.Offset(j, 0).EntireRow.Delete
j = j - 1
End If
End If
Next j
ActiveCell.Offset(1, 0).Select
End If
Next K
'copy the selected data to the printliste
Range("A200:D300").Copy Sheets("Printliste").Range("G6")
Sheets("Deleliste").Select[/VBA]

My guess is that those nasty, nested loops are your problem. Other thanh that, it is hard to go deeper.

Can you post the workbook, and give a bit more detail in what happens when preparing that data as in the code.

my bad you did that already

I tried attachmand but it dindt show up.

i just saw that the excel file has 130MB and the previous saving was just 229kb what did go wrong?

any ideas!

This is the hole program.

its easy to use, but its slow and has the bad habid to unwanted growt in MB,s

And what about my request ...and give a bit more detail in what happens when preparing that data as in the code.

The program selects a range() from a sheet() places them i "deleliste" and from this list it selects duplicates and sums them and put them in the "printliste"

I think this is the best way to subscribe the proces

tanks add forehand