Hi,
I have a working code for splitting data based on client numbers.
My problem is it takes forever to run this.
This is only the first part below and i have to check over a hundred specific numbers.
Does anybody know a way to optimize this ?
Thanks in advance
I have a working code for splitting data based on client numbers.
My problem is it takes forever to run this.
This is only the first part below and i have to check over a hundred specific numbers.
Does anybody know a way to optimize this ?
Thanks in advance
VBA Code:
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
Dim Condition As Worksheet
Set Source = ActiveWorkbook.Worksheets("Import")
Set Target = ActiveWorkbook.Worksheets("Opsplitsing")
Set Condition = ActiveWorkbook.Worksheets("Klantnrs")
j = 1 'This will start copying data to Target sheet at row 1
For Each d In Condition.Range("A2")
For Each c In Source.Range("A2:A200")
If d = c Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c
Next d
j = 10 'This will start copying data to Target sheet at row 1
For Each d In Condition.Range("A3")
For Each c In Source.Range("A2:A200")
If d = c Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c
Next d
j = 20 'This will start copying data to Target sheet at row 1
For Each d In Condition.Range("A4")
For Each c In Source.Range("A2:A200")
If d = c Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c
Next d
j = 30 'This will start copying data to Target sheet at row 1
For Each d In Condition.Range("A5")
For Each c In Source.Range("A2:A200")
If d = c Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c
Next d
j = 40 'This will start copying data to Target sheet at row 1
For Each d In Condition.Range("A6")
For Each c In Source.Range("A2:A200")
If d = c Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c
Next d
j = 50 'This will start copying data to Target sheet at row 1
For Each d In Condition.Range("A7")
For Each c In Source.Range("A2:A200")
If d = c Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c
Next d
j = 60 'This will start copying data to Target sheet at row 1
For Each d In Condition.Range("A8")
For Each c In Source.Range("A2:A200")
If d = c Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c
Next d