I have a basic loop that drops a value into a cell on one sheet, calculates the entire workbook, and returns a couple of values to another sheet. The values being returned are contingent upon the entire workbook being calculated each time. Initially, this worked great, but now that I have many more formulas to calculate the loop is way too slow. Is there a common solution to this problem? Below is the code I have that works, but is way too slow.
Application.ScreenUpdating = False
Dim wsRepository As Worksheet
Dim wsInput As Worksheet
Dim i As Integer
Set wsRepository = ThisWorkbook.Sheets("Repository")
Set wsInput = ThisWorkbook.Sheets("Input")
For i = 4 To 2004
'add investment amount
wsInput.Range("N13").Value = wsRepository.Range("B" & i).Value
'copy back amounts
wsRepository.Range("E" & i).Value = wsInput.Range("U12").Value
wsRepository.Range("C" & i).Value = wsInput.Range("V12").Value
wsRepository.Range("D" & i).Value = wsInput.Range("W12").Value
Next i
wsInput.Activate
Try bracketing your invocation of Calculate with Application.ScreenUpdating = False and Application.SCreenUpdating = True. That should improve your performance dramatically as EXCEL stops trying to redraw the screen on evaluation of every new value.
If you do not provide any additional input it will be hard to provide you with any suggestions.
In general VBA performance can be improved in multiple ways. Here are most of them:
http://blogs.office.com/2009/03/12/excel-vba-performance-coding-best-practices/
Related
Hello stackoverflow community,
I must confess I primarily code within MS Access and have very limited experience of MS Excel VBA.
My current objective is this, I have an expense report being sent to me with deductions in another countries currency, this report has many columns with different account names that may be populated or may be null.
I currently have a Macro that will open an input box and ask for the HostCurrency/USD Exchange rate, my next step will be to start at on the first record (Row 14; Column A-K contains personal info regarding the deduction) then skip to the first deduction account (deduction accounts start at column L and span to column DG) checking if each cell is null, if it is then keep moving right, if it contains a value then I want to multiply that value by my FX rate variable that was entered in the input box, and update the cell with the converion. Once the last column (DG) has been executed I want to move to the next row (row 15) and start the process again all the way until the "LastRow" in my "Used Range".
I greatly appreciate any feedback, explanations, or links that may point me towards my goal. Thank you in advance for taking the time to read though this!
First off, you really should attempt to write the code yourself and post what you have so someone can try to point you in the right direction. If your range is going to be static this is a very easy problem. You can try something along the lines of:
Sub calcRate(rate As Double, lastrow As Integer)
Dim rng As Range
Set rng = Range("L14" & ":DG" & lastrow)
Dim c As Variant
For Each c In rng
If c.Value <> "" Then
c.Value = c.Value * rate
End If
Next
End Sub
This code will step through each cell in the given range and apply the code without the need for multiple loops. Now you can call the calcRate sub from your form where you input the rate and lastrow .
This will do it without looping.
Sub fooooo()
Dim rng As Range
Dim mlt As Double
Dim lstRow As Long
mlt = InputBox("Rate")
With ActiveSheet
lstRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Set rng = .Range(.Cells(14, 12), Cells(lstRow, 111))
rng.Value = .Evaluate("IF(" & rng.Address & " <>""""," & rng.Address & "*" & mlt & ","""")")
End With
End Sub
If your sheet is static you can replace ActiveSheet with WorkSheets("YourSheetName"). Change "YourSheetName" to the name of the sheet.
I have large table with values in range H2:PIG2202. I need to compare the first rows H2:PIG2 values with all other rows values. And if there is a match in the result table it pastes just those values which matched.
Now I'm using this formula in the result table to display needed values:
=IF(sheet!H$2=sheet!H3;IF(AND(sheet!H3;ISBLANK(sheet!H3))=FALSE;sheet!H3;"");"")
The VBA code is:
Sub find()
Application.ScreenUpdating = False
Range("H2:PIG2202").FormulaR1C1 = _
"=IF('sheet'!R2C='sheet'!R[1]C,IF(AND('sheet'!R[1]C,ISBLANK('sheet'!R[1]C))=FALSE,'sheet'!R[1]C,""""),"""")"
Application.ScreenUpdating = True
End Sub
The problem is that Excel shows an error when I run this macros that there are not enough system resources.
Also I would like that in the result table would be just values, not formulas.
Is that possible to do? I have no idea how to achieve this :(
Thank you in advance!
Quick solution for your which is not sophisticated and I'm rather not proud of it (but it was quickest to prepare). Keep in mind that you are going to run it 24m times which could take several minutes, maybe an hour. Some comments inside the code.
Sub Solution()
Application.ScreenUpdating = False
'-----previous one
'Range("H2:PIG2202").FormulaR1C1 = _
"=IF('sheet'!R2C='sheet'!R[1]C,IF(AND('sheet'!R[1]C,ISBLANK('sheet'!R[1]C))=FALSE,'sheet'!R[1]C,""""),"""")"
'----- new one- inserting values- first idea, simple code
Dim Cell As Range
'run for one row first to check if it is ok! and check time needed per row
'next change range to one you expect
'next- take a cup of coffee and relax...
For Each Cell In Range("h2:PIG2")
Cell.FormulaR1C1 = _
"=IF('sheet'!R2C='sheet'!R[1]C,IF(AND('sheet'!R[1]C,ISBLANK('sheet'!R[1]C))=FALSE,'sheet'!R[1]C,""""),"""")"
Cell.Value = Cell.Value
'to trace progress in Excel status bar
Application.StatusBar = Cell.Address
Next Cell
Application.ScreenUpdating = True
End Sub
I’ve been working on this VBA code for a while and since I’m a complete noob I feel like I haven’t gotten anywhere. I’ve been researching a ton, but can’t seem to combine answers to help with my scenario.
Essentially what I’m trying to do is grab data, line by line, from one worksheet and extrapolate it to another worksheet. I believe this will involve loops and I’m so new with VBA I don’t know how to do it.
Here’s the logic I’m attempting:
For each row on worksheet 1, I would like to perform 3 different copy and paste activities to worksheet 2 and then it will loop down to the next row on sheet1 and do the 3 activities and so on. This will continue downwards until column A is blank in sheet1. Sheet1 data starts at A3 and sheets2 paste area starts at A2.
The first activity is to copy cells F3,D3,A3, and H3 (in that order so F3 will be A2, D3 will be B2 etc) from sheet 1 to sheet 2 to A2,B2,C2, etc. A destination functions can’t be used because I need just the values and no other formats—one of the many issues I’ve ran in to.
The next activity is to copy cells F3,D3,A3 and I3 from sheet 1 to sheet2 pasted below the previous copy and paste—again no formats just values. Also to note, some of these may be blank (except A column) but I still need that row there with at least column A data—this goes to say with all these activities.
The third activity is to copy and paste sheet1’s F3,D3, and A3 a certain number of times referencing K3’s number—and each copy and paste will be in the next available blank cell. So if the number in K3 it will look like it created 3 rows in sheet2—totaling 5 rows on sheet2 since activity1 and 2 each create their own row.
After these three activities are completed for row 3 on sheet 1, it will then move to row 4 and do the previous three activities and paste to sheet2. And again it will be pasting no formats and in the next blank row on sheet 2. Also again, this loop will stop once the cell in Column A is blank.
Below is my incomplete code. I don’t even think it will help one bit and it would probably be better not to even look at it. I’ve just started to get frustrated since I can’t even do a simple copy and paste, yet alone loops within loops. I also haven’t even started on my third activity. I greatly appreciate it!
Sub copyTest3()
Dim proj As Range, release As Range, pm As Range, lead As Range, coord As Range
Dim leadCopy As Range, coordCopy As Range
Dim i As Range
Set proj = Range("A3", Range("A3").End(xlDown))
Set release = Range("D3", Range("D3").End(xlDown))
Set pm = Range("F3", Range("F3").End(xlDown))
Set lead = Range("H3", Range("H3").End(xlDown))
Set coord = Range("I3", Range("I3").End(xlDown))
Set leadCopy = Union(pm, release, proj, lead)
Set coordCopy = Union(pm, release, proj, coord)
For i = 1 To Range(ActiveSheet.Range("A3"), ActiveSheet.Range("A3").End(xlDown))
leadCopy.Copy
Sheets("Sheet2").Activate
Range("A2").Select
ActiveSheet.PasteSpecial xlPasteValues
Application.CutCopyMode = False
Sheets("Sheet1").Activate
coordCopy.Copy
Sheets("Sheet2").Activate
Range("A2").Select
ActiveSheet.PasteSpecial xlPasteValues
Next i
End Sub
There are many ways to do this, and some are more efficient than others. My solution may not be the most efficient, but hopefully it will be easy for you to understand so that you can learn.
It's very difficult to understand what you're attempting to do in activity three, so I wasn't able to provide a solution to that step. Use my code as a template for step three and if you run into issues, feel free to leave a comment.
Notice that I don't use .Activate, .Select, or .Copy in this code. .Activate and .Select are huge efficiency killers, and they make it easier for your code to "break," so avoid using them when possible. .Copy isn't necessary when working with values or formulas and will also slow your code down.
Untested
Sub testLoopPaste()
Dim i As Long
Dim ii As Long
Dim i3 as Long
Dim LastRow As Long
Dim wb As Workbook
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Set wb = ThisWorkbook
Set sht1 = wb.Sheets("Sheet1")
Set sht2 = wb.Sheets("Sheet2")
'Find the last row (in column A) with data.
LastRow = sht1.Range("A:A").Find("*", searchdirection:=xlPrevious).Row
ii = 2
'This is the beginning of the loop
For i = 3 To LastRow
'First activity
sht2.Range("A" & ii) = sht1.Range("F" & i).Value
sht2.Range("B" & ii) = sht1.Range("D" & i).Value
sht2.Range("C" & ii) = sht1.Range("A" & i).Value
sht2.Range("D" & ii) = sht1.Range("H" & i).Value
ii = ii + 1
'Second activity
sht2.Range("A" & ii) = sht1.Range("F" & i).Value
sht2.Range("B" & ii) = sht1.Range("D" & i).Value
sht2.Range("C" & ii) = sht1.Range("A" & i).Value
sht2.Range("D" & ii) = sht1.Range("I" & i).Value
ii = ii + 1
'Third activity
For i3 = 1 To sht1.Range("K" & I)
sht2.Range("A" & ii) = sht1.Range("F" & i).Value
sht2.Range("B" & ii) = sht1.Range("D" & i).Value
sht2.Range("C" & ii) = sht1.Range("A" & i).Value
ii = ii + 1
Next i3
Next i
End Sub
The way I usually approach copying data between sheets in Excel is to create source range and destination range objects, each range referring to just one row. When I want to move on to the next row, I use Offset to return a range offset to the next row.
Since the ranges only refer to one row, you can index them with an integer to get the cells in the row. E.g. if cursor refers to columns A through D in row 3, cursor(3) will give you the cell C3.
Dim src_cursor As Range
Dim dest_cursor As Range
Set src_cursor = ActiveSheet.Range("A3:I3")
Set dest_cursor = Sheets("Sheet2").Range("A2:D2")
'' Loop until column A is empty in source data
Do Until IsEmpty(src_cursor(1))
dest_cursor(1) = src_cursor(6) '' copy F -> A
dest_cursor(2) = src_cursor(4) '' copy D -> B
'' and so on
'' move cursors to next row
Set src_cursor = src_cursor.Offset(1, 0)
Set dest_cursor = dest_cursor.Offset(1, 0)
Loop
Also, this might be getting a little off topic, but it's a better practice to use an Enum to name the column numbers instead of hardcoding them like I did here.
I wrote a very simple macro in Excel to remove some trailing excessive text. here is the code:
Sub remove_excess_names_from_part_number()
Dim i As Integer
Application.ScreenUpdating = False
For i = 1 To 1000
Cells(i, 3).Value = Left(Cells(i, 3).Value, 10)
Next i
Application.ScreenUpdating = True
End Sub
I cannot see how this can get any simpler and yet I am disappointed by the poor Performance of this code snippet. Doesn't VBA make some optimizations for simple code like that?
Try below code :
Column C is result Column and data is in Column A
Sub remove_excess_names_from_part_number()
Application.ScreenUpdating = False
Dim lastRow As Long
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("C1:C" & lastRow).FormulaR1C1 = "=Left(RC[-2],10)"
Application.ScreenUpdating = True
End Sub
Do you really need VBA for this? If you want you can use Excel's Text To Columns
Let's say the data is like this in Excel
Select your column and Click on Data | Text To Columns
Select Fixed Width in Step 1 of 3
Set your length in Step 2 of 3. If you see below, I have set it for 10
Click Finish and you are done.
Note: If the 10th character is a SPACE then it will be truncated as in Row 2
If you still want a VBA solution then I would recommend loading the entire range in an Array as #assylias suggested and then put it back after performing the calculations.
#Santosh has also given you a suggestion when you can enter the formula in one go to all the cells. If Non VBA option is available to you then you can enter the formula in the cell manually and do an autofill as well :)
I am running into a slight problem when running my VBA code. I am trying to retrieve and check the information in a specified column in excel. It will run 16 times retrieving the information until the 17 time where it doesn't even give me the whats in the column from the workbook. Can you please help or guide me to the solution?
Dim CheckingWhatsInCell As String
Dim i As Integer
Dim j As Integer
Dim ToWorkbook As Workbook
ThisWorkbook.Activate
For i = 1 To 20
CheckingWhatsInCell = Trim(Range("K" & i).Value)
If CheckingWhatsInCell = "Albuquerque NM" Then
Set ToWorkbook = Workbooks.Open("C:\Users\mgonza-c\Documents\TerritoryAlbuquerqueNM.xlsx")
For j = 1 To 139
ToWorkbook.Worksheets("Sheet1").Cells(i, j) = ThisWorkbook.Sheets("Sheet2").Cells(i, j).Value
Next j
End If
Next i
ToWorkbook.Save
ToWorkbook.Close
End Sub
Thanks!
CheckingWhatsInCell = Trim(Range("K" & i).Value)
This code will be looking in ThisWorkbook, which is Active, and in whichever Sheet was last active. Perhaps it's looking in the wrong sheet. The situation will also change when the other workbook is opened, making it active.
Then, as Julien suggests, there may be an odd value in K17.
Also note that you are attempting to Save and Close ToWorkbook even though it may never be assigned to a Workbook.