I Need help speeding up this code that takes about 5 mins to run copying data from multiple columns and combining them

[tonywatsonhelp]

Hi Everyone,

I have a sheet that has columns A to BX with data
then I have another sheet were I want to copy the data to make one big column
but its super slow,

I was wouldering if anyone could think of a way to speed it up?
happy for a total reright

heres my code

Sub Make_Single_Gig_List()
Dim StartTime As Double
Dim SecondsElapsed As Double
  StartTime = Timer

Application.Calculation = xlManual
Application.ScreenUpdating = False
Sheets("Gig Diary 1 Row").AutoFilterMode = False
Sheets("Gig Diary 1 Row").Range("A2:T25000").EntireRow.Delete

Z = 6

For x = 5 To 75 Step 2
Application.StatusBar = "Progress: " & x & " of 75: " & Format(x / 100, "Percent")


i = Split(ActiveSheet.Cells(2, x).Address, "$")(1)
j = Split(ActiveSheet.Cells(2, Z).Address, "$")(1)

GLR = Sheets("Gig Diary").Cells(Rows.Count, "A").End(xlUp).Row
RLR = Sheets("Gig Diary 1 Row").Cells(Rows.Count, "A").End(xlUp).Row + 1
ELR = GLR + RLR - 3

Sheets("Gig Diary").Range("A3:C" & GLR).Copy Sheets("Gig Diary 1 Row").Range("A" & RLR, "C" & ELR) 'Date+Band+Status
Sheets("Gig Diary").Range("D3:D" & GLR).Copy Sheets("Gig Diary 1 Row").Range("G" & RLR, "G" & ELR) 'Venue address
Sheets("Gig Diary").Range("CB3:CB" & GLR).Copy Sheets("Gig Diary 1 Row").Range("H" & RLR, "H" & ELR) 'music
Sheets("Gig Diary").Range("CE3:CE" & GLR).Copy Sheets("Gig Diary 1 Row").Range("I" & RLR, "I" & ELR) 'type of event
Sheets("Gig Diary").Range(i & "1").Copy Sheets("Gig Diary 1 Row").Range("F" & RLR, "F" & ELR) 'instument
Sheets("Gig Diary").Range(i & "3", j & GLR).Copy Sheets("Gig Diary 1 Row").Range("D" & RLR, "E" & ELR) 'Name + Fee

Z = Z + 2

Next x

Application.StatusBar = "Progress: " & x & " of 100: " & Format(x / 100, "Percent")

Application.Calculation = xlAutomatic
Application.StatusBar = False

  SecondsElapsed = Round(Timer - StartTime, 2)
  MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
End Sub

 

[Candyman8019]

I'm not sure if I imagined it, but when I had information going to the status bar, my workbook seemed to slow quite a bit. Maybe try commenting out those lines and see how long it takes.

 

[tonywatsonhelp]

Hi Candyman,
I just tried that and the results were uncertain.
the thing is it takes so long to run if we do not have that it feels like it's just frozen.
I realize sometimes code is just slow, but I had hoped maybe someone could spot a fundamental problem with my code and shazam! everything is fast again,
I had it super fast when I only needed the data but now I need the formating so I have to copy everything over and that seams to be slowing it down big style.
Thanks for your help.
Tony

 

[Candyman8019]

It looks like you’re needlessly repeating this section of code 35 times. It is copy and pasting the exact same ranges each time. Perhaps it could be put outside of the loop? Of course without seeing the actual sheet I’m trying to visualize what you might be trying to accomplish.

Sheets("Gig Diary").Range("A3:C" & GLR).Copy Sheets("Gig Diary 1 Row").Range("A" & RLR, "C" & ELR) 'Date+Band+Status
Sheets("Gig Diary").Range("D3:D" & GLR).Copy Sheets("Gig Diary 1 Row").Range("G" & RLR, "G" & ELR) 'Venue address
Sheets("Gig Diary").Range("CB3:CB" & GLR).Copy Sheets("Gig Diary 1 Row").Range("H" & RLR, "H" & ELR) 'music
Sheets("Gig Diary").Range("CE3:CE" & GLR).Copy Sheets("Gig Diary 1 Row").Range("I" & RLR, "I" & ELR) 'type of event

 

[tonywatsonhelp]

Yes, it needs to repeat that many times,
those 4 areas are details that are the same for everyone,
then we have columns i & J which are the ones that move,
its hard to describe the document but every thing of one job is in one row at the moment,
so for example it might say
12/05/2023 New JOB The High Street

Date	Type	ADD	Time	Name1	Fee	Name 2	Fee	and it carries on with names in each so clusters or two
12/3	new	the st	12	Bob	100	Tom	200	Barry	300
but what i want is all names in one row
Date	type	add	time	name	fee
12/3	new	the st	12	bob	100
12/3	new	the st	12	tom	200
12/3	new	the st	12	barry	300

Like the above but with multiple lines and many more columns