Need help with Visual Basic

D

Daniellel

Board Regular
Joined
Jun 21, 2011
Messages
242
Hi,<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>
<o:p></o:p>
I am completely self-taught with VB and am still a beginner. I have recorded a massive piece of code (it is about 11 pages in word) and it is really slow (about 30 mins) to run the macro. I does have a formula that it pastes into 840 cells on 4 different tabs ("=INDEX(TO3!$C$1:$I$9999,MATCH($A9&$B9,TO3!$A$1:$A$9999&TO3!$B$1:$B$9999,0),COLUMNS(TO3!$C2:C2))" ) I have posted about this before asking if anyone can help me speed it up but nothing has helped a great deal. The only thing people have referred to that I have not tried is a 'Helper Cell' but I am unsure what this means or how to do it. <o:p></o:p>
<o:p></o:p>
What I am really asking is if there is anyone out there that would be kind enough to run his or her expert eyes over it for me and to maybe help out. <o:p></o:p>
<o:p></o:p>
Can you help???<o:p></o:p>
<o:p></o:p>
Many thanks in advance<o:p></o:p>
<o:p></o:p>
Danielle
 
Sort by date Sort by votes
I tried your code out on an older machine and yes it ran very slowly indeed.
Changing all instances of 9999 in the code to just 99 and it took just a few seconds.
So the greatest time is being used concatenating 9999 x 2 pairs of cell values in each cell and doing the vlookup.
1. So the first line of attack is to reduce that 9999 to only what's needed, depending on how many rows there are in sheet TO3; so typically, how many rows are there in that sheet (TO3)? (I'll get the code to determine this anyway, but if there are still going to be thousands then I'll put more effort into (2) below).
2. Next I'll look at the formula itself to see if it can be made more efficient.
 
Last edited:
Upvote 0

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
I see you have pairs of sheets which correspond:
Grads Overview and CSVGrads
78 Overview and CSV78
56 Overview and CSV56
4 Overview and CSV4

1. Will it always be these 4 pairs, or will they have different names/numbers in the future?
2. If they will change, will the characters in red always correspond? (I want to use the first part of the Overview sheet name, and tack it onto the end of CSV to get the other sheet name and use it to create the formula.)
 
Upvote 0
Down to less than 3 minutes on the older machine retaining the 9999 rows in the formulae.
Down to less that 1/3 second on your sample file on the older machine using only as many rows as necessary in the formulae.
Awaiting your answers to my previous questions.
 
Upvote 0
p45cal said:
I tried your code out on an older machine and yes it ran very slowly indeed.
Changing all instances of 9999 in the code to just 99 and it took just a few seconds.
So the greatest time is being used concatenating 9999 x 2 pairs of cell values in each cell and doing the vlookup.
1. So the first line of attack is to reduce that 9999 to only what's needed, depending on how many rows there are in sheet TO3; so typically, how many rows are there in that sheet (TO3)? (I'll get the code to determine this anyway, but if there are still going to be thousands then I'll put more effort into (2) below).
2. Next I'll look at the formula itself to see if it can be made more efficient.
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>



I see you have pairs of sheets which correspond:
Grads Overview and CSVGrads
78 Overview and CSV78
56 Overview and CSV56
4 Overview and CSV4

1. Will it always be these 4 pairs, or will they have different names/numbers in the future?
2. If they will change, will the characters in red always correspond? (I want to use the first part of the Overview sheet name, and tack it onto the end of CSV to get the other sheet name and use it to create the formula.)
<o:p></o:p>


Down to less than 3 minutes on the older machine retaining the 9999 rows in the formulae.
Down to less that 1/3 second on your sample file on the older machine using only as many rows as necessary in the formulae.
Awaiting your answers to my previous questions.
Click to expand...

Hi p45cal, Sorry for the delay in responding, i have been out of work this morning but am here now...

inanswer to your first question, so typically, how many rows are there in that sheet (TO3)? (I'll get the code to determine this anyway, but if there are still going to be thousands then I'll put more effort into (2) below). There will be an ever changing number of rows here - this totally depends on how many candidates apply, so if we could get the code to work out how many it needed, that would be great!

next...

Will it always be these 4 pairs, or will they have different names/numbers in the future?
These will be the only pairs, nothing else will ever be added.

Please let me know if you need anything else...

Thanks again!
 
Upvote 0
Daniellel said:
There will be an ever changing number of rows here - this totally depends on how many candidates apply, so if we could get the code to work out how many it needed, that would be great!
Click to expand...

Thanks for that, but typically, how many will there be?
 
Upvote 0
p45cal said:
Thanks for that, but typically, how many will there be?
Click to expand...

This is really hard to say, Some days its 1 candidate, others it has been known to be up to 800+. I suppose that it averages around 200 - 300 but this is a very wide average.
 
Upvote 0
The reason I asked is to decide how much effort I put into streamlining that one formula which is slowing everything up. If there were frequently 9000+ rows I would put more effort in, but since you say it has been up to 800+ then I don't think I will put more effort than I have into changing that formula (it has changed to reduce the calculations it performs to 1/7th). By the way, if 800+ is the max, why did you use 9999? Using 2000 would have saved a lot of time by itself!
Anyway, the code below replaces the whole of your Macro1.
Regarding the use of Application.ScreenUpdating, I haven't used it as most of the operations don't affect the screen, no selecting, hidden sheets remain hidden. Do NOT try to set Calculation to manual to speed things up; calculation needs to be on so that the formulae calculate before their results are copied and converted to hard values.
Code: 
Sub Macro1()
DestnRow = 12  'on Scheduling sheet
Sheets("Scheduling").Rows("4:100").Delete
With Sheets("TO3")
  With .Rows("1:5")
    .HorizontalAlignment = xlGeneral
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
  End With  '.Rows("1:5")
  .Columns("A:A").Delete
  .Columns("Y:AB").Cut
  .Columns("A:A").Insert
  .Columns("D:D").Cut
  .Columns("A:A").Insert
  .Columns("F:F").Cut
  .Columns("B:B").Insert
  .Columns("R:S").Cut
  .Columns("H:H").Insert
  .Columns("H:H").Cut
  .Columns("J:J").Insert
  LastRw = .Cells(.Rows.Count, 1).End(xlUp).Row 'uses column A after column swapping completed.
End With  'Sheets("TO3")

Set xxx = ThisWorkbook.Sheets(Array("4 Overview", "56 Overview", "78 Overview", "Grads Overview"))
For Each sht In xxx
  ShortName = Split(Application.Trim(sht.Name))(0) 'these sheet names MUST have a space in.
  With sht
    .Range("A9:A30").FormulaR1C1 = "=CSV" & ShortName & "!R[-7]C[4]"
    .Range("B9:D30").FormulaR1C1 = "=CSV" & ShortName & "!R[-7]C[-1]"
    .Range("E9:K9").FormulaArray = "=INDEX(TO3!R1C3:R" & LastRw & "C9,MATCH(RC1&RC2,TO3!R1C1:R" & LastRw & "C1&TO3!R1C2:R" & LastRw & "C2,0),COLUMN()-4)"
    .Range("E9:K9").AutoFill Destination:=.Range("E9:K30"), Type:=xlFillDefault
    .Range("$A$8:$K$30").AutoFilter Field:=4, Criteria1:="0"
    .Rows("9:209").Delete
    .Range("$A$8:$K$30").AutoFilter

    With .Range("A9").CurrentRegion
      .Value = .Value
      .Borders(xlDiagonalDown).LineStyle = xlNone
      .Borders(xlDiagonalUp).LineStyle = xlNone
      With .Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
      End With
      With .Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
      End With
      With .Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
      End With
      With .Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
      End With
      With .Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
      End With
      With .Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
      End With
      .Copy
      Sheets("Scheduling").Range("A" & DestnRow).Insert Shift:=xlDown
      DestnRow = DestnRow - 2  'adjusts destination row on Scheduling sheet
    End With  '.Range("A9").CurrentRegion
  End With  'sht
Next sht

With Sheets("Scheduling").Range("A4:N4")
  .Merge
  .Font.Bold = True
  .Font.ColorIndex = 3
  .Value = "Report Complete"
  .HorizontalAlignment = xlCenter
  .VerticalAlignment = xlBottom
  .WrapText = False
  .Orientation = 0
  .AddIndent = False
  .IndentLevel = 0
  .ShrinkToFit = False
  .ReadingOrder = xlContext
End With
End Sub
 
Upvote 0
p45cal said:
The reason I asked is to decide how much effort I put into streamlining that one formula which is slowing everything up. If there were frequently 9000+ rows I would put more effort in, but since you say it has been up to 800+ then I don't think I will put more effort than I have into changing that formula (it has changed to reduce the calculations it performs to 1/7th). By the way, if 800+ is the max, why did you use 9999? Using 2000 would have saved a lot of time by itself!
Anyway, the code below replaces the whole of your Macro1.
Regarding the use of Application.ScreenUpdating, I haven't used it as most of the operations don't affect the screen, no selecting, hidden sheets remain hidden. Do NOT try to set Calculation to manual to speed things up; calculation needs to be on so that the formulae calculate before their results are copied and converted to hard values.
Code: 
Sub Macro1()
DestnRow = 12  'on Scheduling sheet
Sheets("Scheduling").Rows("4:100").Delete
With Sheets("TO3")
  With .Rows("1:5")
    .HorizontalAlignment = xlGeneral
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
  End With  '.Rows("1:5")
  .Columns("A:A").Delete
  .Columns("Y:AB").Cut
  .Columns("A:A").Insert
  .Columns("D:D").Cut
  .Columns("A:A").Insert
  .Columns("F:F").Cut
  .Columns("B:B").Insert
  .Columns("R:S").Cut
  .Columns("H:H").Insert
  .Columns("H:H").Cut
  .Columns("J:J").Insert
  LastRw = .Cells(.Rows.Count, 1).End(xlUp).Row 'uses column A after column swapping completed.
End With  'Sheets("TO3")
 
Set xxx = ThisWorkbook.Sheets(Array("4 Overview", "56 Overview", "78 Overview", "Grads Overview"))
For Each sht In xxx
  ShortName = Split(Application.Trim(sht.Name))(0) 'these sheet names MUST have a space in.
  With sht
    .Range("A9:A30").FormulaR1C1 = "=CSV" & ShortName & "!R[-7]C[4]"
    .Range("B9:D30").FormulaR1C1 = "=CSV" & ShortName & "!R[-7]C[-1]"
    .Range("E9:K9").FormulaArray = "=INDEX(TO3!R1C3:R" & LastRw & "C9,MATCH(RC1&RC2,TO3!R1C1:R" & LastRw & "C1&TO3!R1C2:R" & LastRw & "C2,0),COLUMN()-4)"
    .Range("E9:K9").AutoFill Destination:=.Range("E9:K30"), Type:=xlFillDefault
    .Range("$A$8:$K$30").AutoFilter Field:=4, Criteria1:="0"
    .Rows("9:209").Delete
    .Range("$A$8:$K$30").AutoFilter
 
    With .Range("A9").CurrentRegion
      .Value = .Value
      .Borders(xlDiagonalDown).LineStyle = xlNone
      .Borders(xlDiagonalUp).LineStyle = xlNone
      With .Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
      End With
      With .Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
      End With
      With .Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
      End With
      With .Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
      End With
      With .Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
      End With
      With .Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
      End With
      .Copy
      Sheets("Scheduling").Range("A" & DestnRow).Insert Shift:=xlDown
      DestnRow = DestnRow - 2  'adjusts destination row on Scheduling sheet
    End With  '.Range("A9").CurrentRegion
  End With  'sht
Next sht
 
With Sheets("Scheduling").Range("A4:N4")
  .Merge
  .Font.Bold = True
  .Font.ColorIndex = 3
  .Value = "Report Complete"
  .HorizontalAlignment = xlCenter
  .VerticalAlignment = xlBottom
  .WrapText = False
  .Orientation = 0
  .AddIndent = False
  .IndentLevel = 0
  .ShrinkToFit = False
  .ReadingOrder = xlContext
End With
End Sub
Click to expand...


Hi, Thank you so much for all of your help, you have been so wonderful. I really appreciate your time!
 
Upvote 0
OMG!!!!!! I just put your code into my version and run it!!!

ITS AMAZING!!!!!!!!!!!!!!!!!!!! it did not even take a whole second!!!!

I wish i could write code like this! I am going to study it until I understand what you have done.

Thank you Thank you Thank you!!!
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
VBA - Automatically Break the Line in HTML format.
Replies
7
Views
2K
Attrazion
A
S
  • Question Question
IF Command? Help with sales spreadsheet Please
Replies
6
Views
76
etaf
etaf
Z
  • Solved
Need help to update Macro
Replies
3
Views
43
Anthony47
A
A
  • Solved
Copy Entire Workbook, save as sheet name with current date, hide all sheets except one, & attach to email
Replies
2
Views
614
Amo840812
A
C
  • Question Question
Macro Help - Transposing Some Data from Columns to Rows, Accounting for Duplicate Data
Replies
1
Views
127
Kaper
Kaper

Forum statistics

Threads
1,224,596
Messages
6,179,807
Members
452,944
Latest member
2558216095

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top