Forum Discussion
Input data into adjacent cells based on data in cell Copy loop or Visible Cells Paste
Need help in a major way I have tried several different ways to accomplish my goal and everyone of them are too slow. I have a table where I use For Each Cell to look through each cell in a column and if that cell has 1 in it then I need to input a different formula into 12 cells within the same row.
At first I thought this would be very simple. I use VBA and a For Each Cell Loop through the data and where it fond a match it would input the formulas into the cells needed. For example: If Cell A2=1 Then Input Formula1 in B2, Formula2 in D2, Formula3 in H2, Formula4 in J2. I think you get the idea.
Problem: I have 7,126 Rows of data and currently this process takes 5 seconds per row. Which if my math is correct that would be 3,563 Seconds or 59.38 Minutes or 1 Hour? That just will not work.
Next I tried using VBA ListObjects to filter out the data not equal to 1 in Column A. Then do SpecialCells(xlCellTypeVisible) to select and paste the formulas in each of the columns. That took forever, and I even turned off calculations. Even with calculations turned off the Table still wants Calculate each row when I use this method. I also already optimized where I could turning off events, Calculations, ScreenUpdating, The code is set to use the least amount of selects as possible for instance one of the formula inputs I used ActiveCell.Offset(0, 45).FormulaR1C1 = "=IFERROR(INDEX(Table_Query[CPUM32],MATCH([@UIDPS],Table_Query[UIDS],0)),"""")" where I tried the For Each Loop. I also just used Next without the reference next to it because I know that can slow it down as well. I need complete this task in less than 30 seconds or at least under a minute.
What is the fastest way to achieve the end goal?
Why does my Table calculate each cell when I use SpecialCells(xlCellTypeVisible) with calculations turned off?
2 Replies
- Here is some of the code used for this in the For Each Loop method.
Sub FormulaUpdate()
Dim Answer As String
Dim rng As Range, cel As Range
Call Setup
Application.Calculation = xlCalculationManual
Sheets("PV").Select
Range("PV[[#Headers],[On Open Contracts Report]]").Select
ActiveCell.Offset(-1, 0).Copy
Range("PV[On Open Contracts Report]").PasteSpecial xlPasteAll
Selection.Calculate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Set rng = Range("PV[On Open Contracts Report]") ‘Table
Application.CutCopyMode = False
'Add copy loop to loop through each cell in "On Open Contracts Report" and if cell = 1 then paste formula into adjacent cells. If Not, then Next Cell
For Each cel In rng.Cells
cel.Select
If cel.Value2 = 1 Then
ActiveCell.Offset(0, 26).Formula2 = "=XLOOKUP([@UIDPS],Table1[UIDS],Table1[GBUNT],"""")"
ActiveCell.Offset(0, 27).FormulaR1C1 = "=XLOOKUP([@UIDPS],Table1[UIDS],Table1[GBDIV],"""")"
'Update Buyer From Open Contracts Report if Open Contracts = 1
ActiveCell.Offset(0, -1).FormulaR1C1 = "=IFERROR(INDEX(Table1[PLNN06],MATCH([@UIDPS],Table1[UIDS],0)),"""")"
'Update Price & Description if Open Contracts = 1
ActiveCell.Offset(0, 6).FormulaR1C1 = "=IFERROR(INDEX(Table1[BUDC35],MATCH([@UIDPS],Table1[UIDS],0)),"""")"
ActiveCell.Offset(0, 7).FormulaR1C1 = "=IFERROR(INDEX(Table1[BUDC35DSC],MATCH([@UIDPS],Table1[UIDS],0)),"""")"
'Update StockRoom if Open Contracts = 1
ActiveCell.Offset(0, 9).FormulaR1C1 = "=IFERROR(INDEX(Table1[STRM32],MATCH([@UIDPS],Table1[UIDS],0)),"""")"
'Update Major Code, Product Description, Minor Code & Descriptions if Open Contracts = 1
ActiveCell.Offset(0, 21).FormulaR1C1 = "=IFERROR(TEXT(INDEX(Table1[PGMJ35],MATCH([@UIDPS],Table1[UIDS],0)),""000""),"""")"
ActiveCell.Offset(0, 23).FormulaR1C1 = "=IFERROR(INDEX(Table1[PGMN35],MATCH([@UIDPS],Table1[UIDS],0)),"""")"
ActiveCell.Offset(0, 24).FormulaR1C1 = "=IFERROR(INDEX(Table1[PGMN35DSC],MATCH([@UIDPS],Table1[UIDS],0)),"""")"
'Update Commodity Code & Description if Open Contracts = 1
ActiveCell.Offset(0, 29).FormulaR1C1 = "=IFERROR(INDEX(Table1[PCLS35],MATCH([@UIDPS],Table1[UIDS],0)),"""")"
ActiveCell.Offset(0, 30).FormulaR1C1 = "=IFERROR(INDEX(Table1[PCLS35DSC],MATCH([@UIDPS],Table1[UIDS],0)),"""")"
'Update UOM and Conversion Factor if Open Contracts = 1
ActiveCell.Offset(0, 45).FormulaR1C1 = "=IFERROR(INDEX(Table1[CPUM32],MATCH([@UIDPS],Table1[UIDS],0)),"""")"
ActiveCell.Offset(0, 46).FormulaR1C1 = "=IFERROR(INDEX(Table1[SUNT35],MATCH([@UIDPS],Table1[UIDS],0)),"""")"
ActiveCell.Offset(0, 47).FormulaR1C1 = "=IFERROR(INDEX(Table1[SPCF35],MATCH([@UIDPS],Table1[UIDS],0)),"""")"
'Update Contract Base Price, Contract Currency, Contract#, If Open Contracts = 1
ActiveCell.Offset(0, 53).FormulaR1C1 = "=INDEX(Table1[PRICE],MATCH([@UIDPS],Table1[UIDS],0))"
ActiveCell.Offset(0, 54).FormulaR1C1 = "=IFERROR(INDEX(Table1[CURRENCY],MATCH([@UID],Table1[UID],0)),"""")"
ActiveCell.Offset(0, 55).FormulaR1C1 = "=IFERROR(INDEX(Table1[CONTRACT],MATCH([@UIDPS],Table1[UIDS],0)),"""")"
'Update Part Description if Open Contracts = 1
DoEvents ‘Prevents Excel from going non-responsive
ActiveCell.Offset(0, -11).FormulaR1C1 = "=IFERROR(INDEX(Table1[ITEM_DESC],MATCH([@UID],Table1[UID],0)),"""")"
End If
Debug.Print cel.Address ‘Just so I can time how fast it is going.
Next
Application.Calculate ‘When completed calculates the sheet.- Looks like I have solved my issue. For those of you who might have this same issue here is how to resolve it.
I created a new sheet and called it Calc (Calculations). I then copied the data columns I needed to calculate from the Table1 Sheet into the Calc sheet. Since the Table1 Sheet had over 250 columns in a table (and Excel only allows use of half your processor when calculating tables) it made calculating anything in this table slow, very slow. So by taking the 12 columns I needed into another sheet, not using a table format allowed me to filter out the data I did not want to place formula lookups in. Then I I entered my formulas accross row 2 and pasted them down (xlEnd) the sheet as SpecialPaste(xlVisibleCellsOnly). Which only took 5 seconds. I am using VBA of course to automate this entire process. Then, I clear the filters, I copy and paste the updated data from Calc back into Table1 Sheet. Whole process took less than 30 seconds versus what would have taken an hour. Would have been nice not to have to come up with a workaround to make Excel work like it should using the first 2 processes I tried. I had to outsmart the programming to make it work efficiently.
