Thanks for letting us know.
Very much appreciated.
Good Luck.
If the previous code is too slow, this should be faster.
Code
Sub Or_Maybe_So()
Dim nr As Long, fr As Long, lr As Long, lc As Long, x As Long, a, b, j As Long, i As Long, k As Long
Dim matArr, asgArr, banArr
Dim t
nr = WorksheetFunction.CountA(Columns(2))
ReDim b(1 To nr, 1 To 31)
ReDim matArr(1 To nr, 1 To 4)
ReDim asgArr(1 To nr, 1 To 4)
ReDim banArr(1 To nr, 1 To 5)
fr = 2
lc = 31
x = 0
lr = Cells(Rows.Count, 2).End(xlUp).Row
t = Timer
a = Cells(fr, 1).Resize(lr - 1, lc).Value
For i = LBound(a) To UBound(a)
If Len(a(i, 2)) > 3 Then
x = x + 1
For j = 1 To lc
b(x, j) = a(i, j)
Next j
End If
Next i
For k = 1 To nr
matArr(k, 1) = b(k, 3)
matArr(k, 2) = b(k, 2)
matArr(k, 3) = ""
matArr(k, 4) = b(k, 24)
asgArr(k, 1) = b(k, 3)
asgArr(k, 2) = b(k, 2)
asgArr(k, 3) = b(k, 4)
asgArr(k, 4) = b(k, 5)
banArr(k, 1) = b(k, 3)
banArr(k, 2) = b(k, 2)
banArr(k, 3) = b(k, 7)
banArr(k, 4) = b(k, 9)
banArr(k, 5) = b(k, 31)
Next k
Sheets("Matrah").Cells(3, 2).Resize(UBound(matArr), 4) = matArr
Sheets("ASGBORDRO").Cells(3, 2).Resize(UBound(matArr), 4) = asgArr
Sheets("Banka").Cells(10, 3).Resize(UBound(banArr), 5) = banArr
MsgBox "This macro took " & Format(Round(Timer - t, 2), "00:00:00.00") & " seconds to run."
End Sub
Display More