VBA infinite replace loop - excel

I have a workbook with many sheets containing CUBEVALUE formulas. My goal is to wrap these in NUMBERVALUE(), so that null values are shown as zero instead and formulas do not break.
Below is the code I have so far, this works for the most part. However, after replacing the original "CUBEVALUE(" with "NUMBERVALUE(CUBEVALUE(", the VBA keeps replacing the new CUBEVALUE again infinitely. I want to make the VBA stop after changing each cell once.
Current: =CUBEVALUE(formula)
Goal: = NUMBERVALUE(CUBEVALUE(formula))
Sub cube_to_numbercube()
Dim ws As Worksheet
On Error Resume Next
For Each ws In ActiveWorkbook.Worksheets
For Each cell In ws.Cells.SpecialCells(xlCellTypeFormulas)
If cell.Formula Like "*CUBEVALUE*" Then
ws.Range("A:C").Replace "=", "placeholder"
ws.Range("A:C").Replace "CUBEVALUE(", "NUMBERVALUE(CUBEVALUE("
ws.Range("A:C").Replace """]"")", """]""))"
ws.Range("A:C").Replace "placeholder", "="
End If
Next cell
Next ws
End Sub

Your problem is that you have a For Each cell, but then within that, the replace action is happening on ws.Range("A:C") not the individual cell.
Replace all instances of ws.Range("A:C"). with cell. and try again. If you only wish the changes to apply to columns A:C, change your For line to For Each cell in ws.Range("A:C").SpecialCells(xlCellTypeFormulas)
So your updated code should be:
Sub cube_to_numbercube()
Dim ws As Worksheet
On Error Resume Next
For Each ws In ActiveWorkbook.Worksheets
For Each cell In ws.Range("A:C").SpecialCells(xlCellTypeFormulas)
If cell.Formula Like "*CUBEVALUE*" Then
cell.Replace "=", "placeholder"
cell.Replace "CUBEVALUE(", "NUMBERVALUE(CUBEVALUE("
cell.Replace """]"")", """]""))"
cell.Replace "placeholder", "="
End If
Next cell
Next ws
End Sub

Your (inner) loop runs for every single cell containing a formula, but within the loop, you replace all formulas at once. Meaning if you have 100 cells with formulas, your loop will run 100 times and replace every formula containing CUBEVALUE 100 times with NUMBERVALUE(CUBEVALUE(.
Likely at a certain moment, the formula gets too long and Excel will refuse to replace it. This will cause a runtime error but you are hiding all runtime errors with On Error Resume Next.
Now replacing all formulas at once is not a bad idea in general as it will speed up your process. You could remove the inner For Each completely (and the If-statement). However, if for some reasons you need to run the code again (for example because some new formulas where added), you would still have the issue that for every run another NUMBERVALUE-function would be added. Furthermore, the Replace-statement could affect also formulas that shouldn't be affected (for example the 3rd replace statement).
So I would suggest you keep the inner For Each and replace the formula for every cell separately. With that, you can check if the formula really needs to be replaced and it wouldn't be an issue if the code runs several times.
Also, it is easier to do the string handling within VBA. Read the formula into a variable, make the replacement and write it back.
Dim cell As Range, formula As String
For Each cell In ws.Cells.SpecialCells(xlCellTypeFormulas)
formula = cell.formula
If formula Like "*CUBEVALUE*" And Not formula Like "*NUMBERVALUE*" Then
formula = Replace(formula, "CUBEVALUE(", "NUMBERVALUE(CUBEVALUE(")
formula = Replace(formula, """]"")", """]""))")
cell.formula = formula
End If
Next cell
And get rid of the On Error Resume Next - this statement will not prevent runtime errors, it simply doesn't show them which means that you will not be informed if something fails.

Related

Printing out ActiveCell value on VBA

I'm trying to make a button which on click will print out the value of a cell as a string and not the appearance of the cell itself (if that makes sense) using the .PrintOut method in VBA. That cell is the active cell, whose value I set based on the cell next to it. Here is my code:
Sub Graphic2_Click()
Dim MyNumber as Integer
MyNumber = ActiveCell.Offset(-1, 0) + 1
ActiveCell.Value = MyNumber
ActiveCell.Printout
End Sub
I also tried MyNumber.PrintOut but I get an "Invalid Qualifier" error.
Am I missing out something too simple?
Please, try the next code. It use a temporary 'helper cell' where the format to be pasted (and recuperated after printing out):
Sub Graphic2_Click()
Dim helperCell As Range
With ActiveCell
.value = CLng(Offset(-1, 0)) + 1
Set helperCell = .Offset(1) 'it may be any cell to temporarilly be used
.Copy
helperCell.PasteSpecial xlPasteFormats
.ClearFormats
.PrintOut
helperCell.Copy
.PasteSpecial xlPasteFormats: helperCell.ClearFormats
End With
End Sub
To literally print just the contents of the cell:
Clear number formatting for the specified cell
Autofit column width for that column
Turn off gridlines
Turn off row and column headings
Set print area to the single cell, dismissing any warnings
Print out the active sheet
Each of these are straightforward to do in VBA, and probably straightforward to research on SO anyway.
You may also consider a mechanism to return the changed settings to their initial states afterwards. This would involve pushing (storing) the initial state to a variable or variables first, and popping (restoring) it back afterwards.
Explanation:
The VBA method .PrintOut is something you do to a worksheet, not a cell or its contents. Therefore, to get what you need, you need to set up the worksheet for printing so that the only thing that will appear is the contents of your chosen cell. This is what the above steps do.
For more information about the .PrintOut method, see:
https://learn.microsoft.com/en-us/office/vba/api/excel.sheets.printout
Or, to continue what the OP tried:
You could try something like:
ActiveCell.Formula = Range(ActiveCell.Offset(-1,0)).Value2 + 1
If this does not work, try:
ActiveCell.Formula = Range(ActiveCell.Offset(-1,0).Address).Value2 + 1
Or try these without the + 1 on the end, to verify that the rest of the formula is working the way you want it too. As mentioned, you may get a type mismatch issue causing an error if you don't trap first for whether the referenced cell contains a number.
.Formula in this example is how I am setting the content of the cell, and it can be used even when setting a value not necessarily literally a formula. You could use Value instead if you prefer.
.Value2 is a robust method of extracting the evaluated content of the source cell, as a value instead of as a formula.
The PrintOut method is to print a worksheet, not a range or single cell.
Note: This answer is not tested, as I am not near Excel right now.
Also... it's possible that there could be much simpler ways to do what you are trying to accomplish. Could you provide a bit more detail about the context of what you are trying to do.

Repeating Formula with Incrementing Cell Reference

So I have built a formula that has Absolute Cell References, and wanted to repeat the same formula down 3000 cells with each one referencing increment cells. (1st formula referring to Cell $A$1, 2nd formula referring to $A$2) I know that I could easily do this without referencing exact cells and the Fill Handle and this is currently how it's set up, however there's a very large number of people who work in this spreadsheet that have bad Excel manners, and regularly delete rows and cells or copy and paste, which breaks the formulas.
Rather than manually editing the same formula in each cell to change the references from relative to absolute, I was wanting to run a Macro to automatically run the formula for 3000 cells.
I had at first built a Macro that fills 20 cells with the formula, but it didn't adjust the formula based on the active cell. (Always entered with range $A$1:$A$20, and not $A$21:$a$40 when started further down) I changed the Macro to loop, but it looks with all formulas referencing $A$1 rather than updating.
The Macro set up to loop is as follows:
Sub HDDatesRef()
ActiveCell.Select
ActiveCell.FormulaR1C1 = "=IF(AND(HD!R1C1>0,ISBLANK(HD!R1C4)),HD!R1C1,""n/a"")"
ActiveCell.Offset(1, 0).Range("A1").Select
Loop Until ActiveCell.Value = ""
End Sub
Any and all help with figuring this out would help immensely. Right now I also have access to Liknedin Learning, so if there's any suggestions for courses on there I should look into so I can understand what I need to do will help with this.
The Excel application object has a function called ConvertFormula which you can use to change a formula between reference styles (A1 or R1C1) and to specify whether the rows and columns should be relative references or absolute references.
If you start off by creating the formula in each row as a relative reference then you can use ConvertFormula to turn it into an absolute reference. The only restriction is that the formula cannot be longer than 255 characters.
Adapting your code and following the advice in How to avoid using Select in Excel VBA gives us:
Option Explicit
Sub HDDatesRef()
Dim r As Range
' If we know the cell address we want to start in then we could use that directly
' e.g. Set r = Worksheets("HD").Range("E1")
Set r = ActiveCell
Do
' The With block just saves us typing r.FormulaR1C1 multiple times
With r
' Don't know what your relative formula would be. I've assumed that we are
' working in column E but adjust as appropriate
.FormulaR1C1 = "=IF(AND(HD!RC[-4]>0,ISBLANK(HD!RC[-1])),HD!RC[-4],""n/a"")"
' Take the formula we already have which is in R1C1 format, keep it in R1C1 format,
' change it from a relative reference based on cell r to an absolute reference
' and make that the new formula for this cell
.FormulaR1C1 = Application.ConvertFormula(.FormulaR1C1, xlR1C1, xlR1C1, xlAbsolute, r)
End With
' Move down one row
Set r = r.Offset(1, 0)
Loop Until r.Value = ""
End Sub
In case you aren't familiar with them. here are the references for Option Explicit and With...End With
You can do this without looping, Excel is smart enough to know you want incremental.
As an example do run this on a fresh sheet:
Sub ShowIncremental()
Range("A1:A10").Formula = "=Row(A1)"
Range("B1:B10").Formula = "=A1*2"
Range("C1:C10").Formula = "=sum(B$1:B1)"
End Sub
Notice the formulas created in A1:C10. Notice Excel incremented them even though the code didn't say to except in the case where we absoluted B$1.
I recommend you do something similar with your code to avoid looping, this will be much much faster.

vba excel looping thru an array

I'm a rookie at vba.
I created a solution that works on a micro basis, but can't get the same code to run when I add additional parameters to that code.
I created a multiple choice quiz with answer cells which test against the answers on a separate (hidden) sheet. An adjacent cell shows Yes or No response. That functionality which I researched on the web works well. I'm trying to clear.contents for all the cells so that the user can complete the quiz, clear all responses to give it another go.
I have 395 questions which I created code to clear "Range("B2").ClearContents"
My subroutine has 395 such commands and takes 45-60 seconds. I'm looking for a more efficient solution. I don't want to clear the entire column only the 395 non-adjacent cells which have user input.
Sub Test_Clear()
Range("B2,B5,B7,B9,B11").ClearContents
End Sub
My list of cells is on Sheet2 D1:D395 Each cell in D1:D395 lists a cell on Sheet1 which I want to clear (i.e. B6, B11, B17, B22, B35 etc.) How can I reference those cells on Sheet2 and perform the ClearContents?
While you could just hard code your list in VBA instead of your Sheet2 range, here is how you could reference that list of cells in sheet2 and clear the contents all at once:
Sub clearall()
Dim rngCell, listCells As String
For Each rngCell In Sheet2.Range("D1:D395").Cells
If listCell <> "" Then listCell = listCell & "," & rngCell.Value Else listCell = rngCell.Value
Next
Sheet2.Range(listCell).ClearContents
End Sub
If you just want to clear the cells in column A which have something in them you could use this
Sheet1.Range("A:A").SpecialCells(xlCellTypeConstants).ClearContents
'or
Sheet1.Range("A1:A395").SpecialCells(xlCellTypeConstants).ClearContents
The VBA Join function can be used to join values into string, and the Excel Transpose function is needed to "flip" the column values 2D array to a 1D row values array:
stringAdress = Join([Transpose(Sheet2!D1:D395)], ",")
ThisWorkbook.Worksheets("Sheet1").Range(stringAdress).ClearContents
If any of the cells in the Sheet2!D1:D395 range are blank, the above will result in error.
In Excel 2016, the TextJoin function can be used to ignore empty cells (not tested):
stringAdress = [TextJoin(",", True, Sheet2!D1:D395)]
ThisWorkbook.Worksheets("Sheet1").Range(stringAdress).ClearContents

How to update cell references when moving cells into same sheet as target?

How do you force an excel workbook to use itself as a source for worksheet links?
I'm writing a VBA macro to automate the process of adding an excel worksheet into a workbook. The worksheet (sheet1) takes only certain (but very many) responses from within the several sheets (response1, response2, response3) of the questionnaire. As a result of this, sheet1 contains lots of cell references that don't lead anywhere until after the macro is run.
For instance a1 in sheet1 "='response1'!b6". This returns a #REF! error before the macro is run (which is fine).
After the macro is run sheet1 is now inside the correct workbook, and "='response1'!b6" is now a valid cell reference.
Except excel doesn't realise this until after I manually click the cell in Sheet1, press f2, then press enter. When I do this the cell is correctly populated. The trouble is there are large numbers of cells.
Is it possible to construct a VBA macro that will simulate this process of selecting formula boxes and pressing "Enter". Looking up people with similar problems, most have had the problem remedied by some combination of f9, turning automatic calculation back on, or ActiveSheet.Calculate or a variant. None of these have worked, it appears to be an issue with references, even though the references point to valid locations.
Otherwise, is it possible to use VBA to perform the same process as:
Data > Edit Links > Update Values
But in this case we'd need to specify the currently opened workbook as it's own source. Is there any way to do this?
When I manually selected the current workbook as the source under "Edit Links > Update Values" excel strangely repeats the worksheet name in the cell references, like this: "='[response1]response1!B31", which then fails to update when cell b31 changes, so this is not a solution.
Here's the code that runs on button press:
Private Sub CommandButton1_Click()
'copy worksheet into responses
Dim CopyFromWbk As Workbook
Dim CopyToWbk As Workbook
Dim CopyToWbk As Workbook
Set CopyFromWbk = Workbooks("Addition.xlsm")
Set ShToCopy = CopyFromWbk.Worksheets("Sheet1")
Set CopyToWbk = Workbooks("QuestionnaireResponses.xlsm")
ShToCopy.Copy After:=CopyToWbk.Sheets(CopyToWbk.Sheets.Count)
Workbooks("QuestionnaireResponses.xlsm").Activate
'Put code to update links in here
ThisWorkbook.UpdateLink Name:="myfilepathgoeshere.QuestionnaireResponses.xlsm", Type:=xlExcelLinks
'End update links
Thanks for any help, this one's a head scratcher.
Great idea from #Kyle. For those who having trouble forcing cell references to update, TextToColumns works.
However TextToColumns draws an error if the source range is empty, so if there's any chance of that being the case use an if statement with no action attached to skip over those instances.
My successful code looks like this:
Dim i As Integer
For i = 1 To 1004
'Scans through row 2 from col A onwards
'If cell is empty, does nothing.
'If cell is not empty, performs TextToColumns where source range = target range.
If IsEmpty(Workbooks("QuestionnaireResponses.xlsm").Worksheets_
("response1").Cells(2, i)) Then 'Does nothing if the cell is empty.
Else
Workbooks("QuestionnaireResponses.xlsm").Worksheets("response1").Cells(2, i).Select
Selection.TextToColumns Cells(2, i) 'Performs TextToColumns
End If
Next
All of my data is on the same long row. To apply the above to an entire spreadsheet, just nest everything between, and including, For i = 1 and Next within another For loop with different letter replacing i.

Iferror return 0 for worksheet VBA

I have a pretty extensive workbook with thousands of references. My boss would like me to make a consolidated list of GP, Profit, Expenses for all items but in doing so easily I would need to remove all "#N/A" cells without compromising the integrity of such cell formulas. AKA I don't just want to clear the cells that return "#N/A"s but rather start each formula with an =IFERROR(cell,0). Can someone please help me write a VBA code that will take each cell on a selected WORKSHEET and insert an IFERROR return "0"? It is important that the VBA only works on selected worksheets since I don't want my whole workbook overwrited with IFERROR statements.
Sub WrapIFERROR()
Dim Cell As Range
For Each Cell In ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas)
Cell.Formula = "=IFERROR(" & Mid(Cell.Formula, 2) & ",0)"
Next
End Sub

Resources