Please help to optimize my code. Thank you!

[bunny1122]

Hi All

I have a macro below but it seems to run extremely slow and my excel will just hang and not respond. Is there something wrong with my code and any way to speed things up? Thank you.

Sub Update_data()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

'Update Exposure

'Source file path (wb)
Source_path = Sheets("Source").Range("B4").Value
Alternative_sourcepath = Sheets("Source").Range("B5").Value

Source_filename = Sheets("Source").Range("A14").Value

'Open Source file

Dim wb As Workbook
Dim wb1 As Workbook

On Error Resume Next

Set wb = Workbooks.Open(Source_path & Source_filename, False, True)


On Error GoTo 0

If wb Is Nothing Then

Set wb1 = Workbooks.Open(Alternative_sourcepath & Source_filename, False, True)

Application.DisplayAlerts = True

End If

'Copy Data
ActiveWorkbook.Sheets("page1").Activate

  Dim i As Long, nr As Long
 
  nr = ThisWorkbook.Sheets("Report").Range("C" & Rows.Count).End(xlUp).Row + 1

    If nr < 6 Then nr = 6

With ActiveWorkbook.Sheets("page1").Range("B3:O37")
For i = 1 To Columns.Count
.Columns(i).Copy Destination:=ThisWorkbook.Sheets("Report").Cells(nr, 3 * i)

Next i



End With

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

 

[JGordon11]

I think you're missing a dot, causing the loop to run for all the columns in the sheet rather than just B through O

Change

For i = 1 To Columns.Count

To

For i = 1 To .Columns.Count

 

[bunny1122]

Thank you so much for the fix!

 

[bunny1122]

Hi guys, not sure if I can continue on this thread. Please let me know if I need to create a new thread.

I have another code that I couldn't figure out how to fix it. Bottom code is a partof a longer macro.

Sub test()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

'Source file path (wb)
Source_path = Sheets("Source").Range("B4").Value
Alternative_sourcepath = Sheets("Source").Range("B5").Value

Source_filename = Sheets("Source").Range("A18").Value

'Open Source file

Dim wb As Workbook
Dim wb1 As Workbook

On Error Resume Next

Set wb = Workbooks.Open(Source_path & Source_filename, False, True)


If wb Is Nothing Then

Set wb1 = Workbooks.Open(Alternative_sourcepath & Source_filename, False, True)

Application.DisplayAlerts = True

End If

'Copy IRO Daily PV01 EXP & %
    
   On Error Resume Next

wb.Sheets("FXO_IRD_IRO_PV01_BD1_EXT1").Activate


If wb Is Nothing Then

wb1.Sheets("FXO_IRD_IRO_PV01_BD1_EXT1").Activate

End If


 ActiveWorkbook.Sheets("FXO_IRD_IRO_PV01_BD1_EXT1").Activate

  Dim i7 As Long, nr7 As Long
  
  nr7 = ThisWorkbook.Sheets("FXD_NL_PV01").Range("CO" & Rows.Count).End(xlUp).Row + 1
  lastrow7 = Cells(Rows.Count, 1).End(xlUp).Row

    If nr7 < 6 Then nr7 = 6

With ActiveWorkbook.Sheets("FXO_IRD_IRO_PV01_BD1_EXT1").Range("C3:AF" & lastrow7)
For i7 = 1 To .Columns.Count Step 2
.Columns(i7).Resize(, 2).Copy Destination:=ThisWorkbook.Sheets("FXD_NL_PV01").Cells(nr7, (i7 + 61) * 3 / 2)

Next i7


End With

When I run the full macro, my excel will just hang and when I test run line by line, I found the below line is looping forever causing it to hang. However, when i copied the code on its standalone module, it will complete within seconds without hang. Why is that ?

Appreciate any inputs, thank you

With ActiveWorkbook.Sheets("FXO_IRD_IRO_PV01_BD1_EXT1").Range("C3:AF" & lastrow7)
For i7 = 1 To .Columns.Count Step 2
.Columns(i7).Resize(, 2).Copy Destination:=ThisWorkbook.Sheets("FXD_NL_PV01").Cells(nr7, (i7 + 61) * 3 / 2)

Next i7