I've got a code that i need to run monthly on 500.000 lines of Excel database. Code goes through 1 whole database of different Owbers and splits it onto different tabs - creating them if they don't originally exist. I'm pretty new to coding and creating it and making it work was a big success for me, but it takes ages for it to go through the whole spreadsheet (5mins / 10.000 records - around 3 - 5 hours through the whole spreadsheet). Is anyone able to have a look and maybe make it work faster? I'm not good with understanding arrays, but i think working on them could make it work better.
Sorry for poor coding:
`
'Loop through spreadsheet and create new tabs if needed
Sub Copy_To_Tab()
Dim Main As Worksheet
Dim a, LR, LR2, LR3 As Integer
Dim Sht As String
Set Main = Sheets(1)
Application.ScreenUpdating = False
a = 2
LR = Main.Range("A" & Rows.Count).End(xlUp).Row
Do Until a > LR
ponownie:
Sht = Main.Range("R" & a).Value
If Sht = "" Then GoTo drugi:
On Error Resume Next
LR2 = Sheets(Sht).Range("A" & Rows.Count).End(xlUp).Row + 1
If Err.Number = 9 Then GoTo stworz:
Main.Range("A" & a & ":AB" & a).Copy Sheets(Sht).Range("A" & LR2)
drugi:
If Main.Range("R" & a).Value <> Main.Range("S" & a).Value Then
ponownie2:
Sht2 = Main.Range("S" & a).Value
If Sht2 = "" Then GoTo nastepny:
On Error Resume Next
LR3 = Sheets(Sht2).Range("A" & Rows.Count).End(xlUp).Row + 1
If Err.Number = 9 Then GoTo stworz2:
Main.Range("A" & a & ":AB" & a).Copy Sheets(Sht2).Range("A" & LR3)
End If
nastepny:
a = a + 1
Loop
Application.ScreenUpdating = True
MsgBox "Finished"
Exit Sub
stworz:
CreateSheet (Sht)
GoTo ponownie:
stworz2:
CreateSheet (Sht2)
GoTo ponownie2:
End Sub
'Create new worksheet and name it
Sub CreateSheet(Nazwa As String)
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets.Add(After:= _
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws.Name = Nazwa
Sheets(1).Range("A1:AZ1").Copy ws.Range("A1")
End Sub
`