Solved: Program is slow

[Volvo850]

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

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

[Bob Phillips]

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.

[CatDaddy]

my bad you did that already

[Volvo850]

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!

[Volvo850]

This is the hole program.

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

[Bob Phillips]

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

[Volvo850]

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