Should this Debug code be used in a VBA object loop? - oop

Looking to include the below code as an instance of a loop through a Set
range object including multiple cell values. This link provides a good overview of Debug.Print but the workings of .Address remain a mystery to me.
Debug.Print .Address
http://www.cpearson.com/excel/DebuggingVBA.aspx

.Address must be related to a cell or range like this:
Debug.Print Range("A1").Address
Or if your using a with statement like this:
With Range("A1")
Debug.Print .Address
End With
The output is printed to your vba immediate window and looks like this:
$A$1
You could also write it to other locations like this:
MsgBox (Range("A1").Address)
Range("B1").Value = Range("A1").Address

Related

How to change range reference with VBA

I have about 300 named ranges that are referring to an external spreadsheet.
for example
Range name: my_range
Refers to: ='\mycompany.com\lucas[Lucas.xlsm]SHEETNAME'!$C$10
I want to replace the "\mycompany.com\lucas[Lucas.xlsm]" with an empty string
I tried researching this online but it doesn't seem like I'm able to phrase it correctly, all the answers are referring to find and replace in cells...
There are a number of resources for doing this in VBA (300+ is a lot to do by hand!).
A great general guide is here: The SpreadsheetGuru's guide to Named Ranges in VBA
To loop through all named ranges and all named ranges in a specific worksheet:
Sub NamedRange_Loop()
'PURPOSE: Delete all Named Ranges in the Active Workbook
'SOURCE: www.TheSpreadsheetGuru.com
Dim nm As Name
'Loop through each named range in workbook
For Each nm In ActiveWorkbook.Names
Debug.Print nm.Name, nm.RefersTo
Next nm
'Loop through each named range scoped to a specific worksheet
For Each nm In Worksheets("Sheet1").Names
Debug.Print nm.Name, nm.RefersTo
Next nm
End Sub
To change the link, instead of using Debug.Print, edit the RefersTo. I can't find a way to directly edit the link, all the documentation suggest that you'd have to delete the link and recreate it with a new reference.
Deleting is easy - nm.Delete
Creating is easy:
'For Workbook level links
ThisWorkbook.Names.Add Name:=RangeName, RefersTo:=cell
'For Worksheet level links
Worksheets("Sheet1").Names.Add Name:=RangeName, RefersTo:=cell
See also:
Names Object
Names.Add Method
Defining and using names in VBA formulas
Looping through all named ranges in excel VBA in current active sheet
If you replace the referring address of a named range with an empty string, Excel deletes the named range. And this is the way I am using to delete a named range:
Public Sub DeleteName(sName As String)
On Error GoTo DeleteName_Error
ActiveWorkbook.Names(sName).Delete
Debug.Print sName & " is deleted!"
On Error GoTo 0
Exit Sub
DeleteName_Error:
Debug.Print sName & " not present or some error"
On Error GoTo 0
End Sub
Simply call it like this:
DeleteName my_range
Actually, the deletion of the named range without .RefersTo is quite clever by the Excel developers - otherwise plenty of errors would appear. Check it out, this code would run only once if you declare my_range1 and my_range2:
Public Sub TestMe()
Dim nameArray As Variant
nameArray = Array("my_range1", "my_range2")
Dim myNameRange As Name
For Each myNameRange In ThisWorkbook.Names
Dim cnt As Long
For cnt = LBound(nameArray) To UBound(nameArray)
If nameArray(cnt) = myNameRange.Name Then
Debug.Print myNameRange
Debug.Print myNameRange.RefersTo
myNameRange.RefersTo = vbNullString
End If
Next cnt
Next myNameRange
End Sub
You should be able to do that from the Data, Edit Links dialog. Select the link in question, click change source and point it to the workbook itself.
If that fails, download my FlexFind tool (http://jkp-ads.com/officemarketplaceff-en.asp), run it and make sure you check the Objects checkbox on the dialog.

Excel VBA: Copying Formula to any active cell

I am new to VBA coding and hope I can get some assistance here. I am trying to create code that would do the following for ANY cell (without specifying hard coded cell ranges or references):
input a formula in the active cell
copy it (fill) down 10 rows
In an attempt to insert the formula into the ActiveCell I tried:
Sub Test()
ActiveCell.formula = "=IF(ISBLANK(C5)*ISBLANK(D5),"",IF(ISBLANK(D5),(C5),CONCATENATE(C5,"" ["", D5, ""]"")))"
End Sub
However, this produces the
1004: Application-define or object-defined error
I've tried declaring Range objects for ActiveCell but still run into errors.
Any help on this would be highly appreciated.
ActiveCell.formula = "=IF(ISBLANK(C5)*ISBLANK(D5),"""",IF(ISBLANK(D5),(C5),CONCATENATE(C5,"" ["", D5, ""]"")))"
you missed doubling up the first set of embedded quotes.
You can use following routine to copy formula from cell to VBE compatible format. See if it helps you:
Public Sub CopyExcelFormulaInVBAFormat()
Dim strFormula As String
Dim objDataObj As Object
'\Check that single cell is selected!
If Selection.Cells.Count > 1 Then
MsgBox "Select single cell only!", vbCritical
Exit Sub
End If
'Check if we are not on a blank cell!
If Len(ActiveCell.Formula) = 0 Then
MsgBox "No Formula To Copy!", vbCritical
Exit Sub
End If
'Add quotes as required in VBE
strFormula = Chr(34) & Replace(ActiveCell.Formula, Chr(34), Chr(34) & Chr(34)) & Chr(34)
'This is ClsID of MSFORMS Data Object
Set objDataObj = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
objDataObj.SetText strFormula, 1
objDataObj.PutInClipboard
MsgBox "VBA Format formula copied to Clipboard!", vbInformation
Set objDataObj = Nothing
End Sub
After inserting this routine. You just need to enter the formula normally in the cell. Then stay on the cell and run this code and it will copy to clipboard. Go to VBE and do CTRL+V to paste the code where required.
Originally posted on:
https://chandoo.org/forum/threads/copy-formula-from-excel-to-clipboard-in-vba-compatible-format.35997/

Application or Object defined error in range.formula

I am trying to set a formula to certain cells. The code for setting the formula in a for loop is like this:
For i = 0 To MotorAmount
Set myCell = Range(Target.Address).Offset(i, 1)
myCell.Formula = "=IFERROR(VLOOKUP(Range(Target.Address);Database!$B$31:$G$131;2;False);0)"
Next i
However I get an application or object defined error on the line that starts with myCell.Formula. I hope someone can tell me why the error occurs and how to fix it.
PS: I use semicolons in the formula because my Excel works like that. the 'Database' is the name of another sheet I use.
PS2: The sub is placed in Sheet1 under Microsoft Excel Objects in the VBAProject.
The complete code is:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRange As Range
Dim myCell As Range
Dim i As Integer
Dim MotorAmount As Integer
Set myRange = Range("A68:A168")
If Not Application.Intersect(myRange, Range(Target.Address)) Is Nothing Then
If Not Range(Target.Address) = "" Then
MotorAmount = InputBox("How many motors are used in this transport?", "Amount of motors")
For i = 0 To MotorAmount
Set myCell = Range(Target.Address).Offset(i, 1)
myCell.Formula = "=IFERROR(VLOOKUP(Range(Target.Address);Database!$B$31:$G$131;2;False);0)"
Next i
End If
End If
End Sub
Your formula implementation should be:
myCell.Formula = "=IFERROR(VLOOKUP(" & Target.Address & ",Database!$B$31:$G$131,2,False),0)"
Note: In VBA use commas while writing formula, in native it will automatically show the correct argument separator you are using.
You can't put code inside a formula and you should be using commas not semicolons in the formula as VBA is US-centric. I'd suggest using R1C1 references:
myCell.FormulaR1C1 = "=IFERROR(VLOOKUP(R" & Target.Row & "C1,Database!R31C2:R131C7,2,False),0)"

Targetting a Range With Dynamic Row Reference Based On Search

I'm real new to VBA coding and have been doing alright but I have now hit a wall with my final (and probably more complex than it needs to be) macro of the worksheet. I've been trying to make it work all weekend through multiple google searches and using various answers from stackoverflow's other questions to compile my own script, but to no avail. This is what I have so far (apologies coders, I know this will look like it was written by a 3 year-old):
Sub Build_Delete()
Dim rngA As Range
Dim cell As Range
Set rngA = Worksheets("Database").Range("D9:D177").End(xlUp)
For Each cell In rngA
If cell.Value = Range("A2").Value Then
cell.Select
Range("D" & ActiveCell.Row & ":AB" & ActiveCell.Row).Select
Selection.Delete
End If
Next cell
End Sub
The above works, no errors are returned, however it doesn't do anything noticeable.
I'm aware this is most likely atrocious, so this is what I am trying to do:
Database!D9:D177 contains the titles for a set of data in columns D to AB (4 to 28) .
There is an ActiveX Search Box that populates cell Database!A2 in real time with whatever is searched (eg. "Test" typed into Search Box, "Test" appears in cell Database!A2).
When I run the macro, I want it to check range Database!D9:D177 for the text string found in Database!A2, then delete the contents of columns D to AB for that row (eg. A2 = "test", Found "test" in cell D21, Delete D21:AB21).
The row is a dynamic value which is what is throwing me mostly with this, but the columns are fixed.
Also, the button for the macro is located on a separate worksheet (Front Page!), but the script will run solely on the Database! page.
Only needs to work in excel, not open office.
Only other thing I can think of that is relevant is that the cells can be left blank after deletion, they do not need to be filled, and the worksheet will never need to be printed so margins aren't an issue.
Optionally I would like to add an "Are You Sure? 'Yes' 'No' Msgbox at the start of the script, but I can play with that later as I know I am pushing my luck with this.
Any help would be greatly appreciated!
I always find it faster to use FIND rather than check the value of each cell.
If you want to find all values in case of duplicates you can go on to use .FINDNEXT(rFound) - https://msdn.microsoft.com/en-us/library/office/ff839746.aspx
Public Sub Build_Delete()
Dim rngA As Range
Dim rFound As Range
Dim wrkSht As Worksheet
Set wrkSht = ThisWorkbook.Worksheets("Database")
Set rngA = wrkSht.Range("D9:D177")
With rngA
Set rFound = .Find(wrkSht.Range("A2"), LookIn:=xlValues, LookAt:=xlWhole)
If Not rFound Is Nothing Then
If MsgBox(rFound.Value & " found on row " & rFound.Row & "." & vbCr & _
"Delete?", vbInformation + vbYesNo) = vbYes Then
rFound.EntireRow.Delete Shift:=xlUp
End If
End If
End With
End Sub

application.run vba not working with sheet macros

My file has different sheets with the same-named sub routine inside each doing different things specific to the sheet. So, I'm trying to call dynamically a macro inside a selected sheet using Application.Run from a module. All sheets' "object" name (I don't know how to call those) are already modified to be the same as its view (inside the bracket) name, without the spaces.
macro = Chr(39) & ThisWorkbook.Name & Chr(39) & "!" & Replace(SheetName, " ", "") & "." & "Harmoniser()"
Application.Run macro
Here's an example of the Harmoniser macro in a Sheet.
Sub Harmoniser()
ActiveSheet.Range("k22").GoalSeek Goal:=0, ChangingCell:=Range("l13")
MsgBox ("Done!")
End Sub
Somehow, only the MsgBox works, and it shows it twice everytime. Debugging by putting a break point doesn't work either. It happens to all of my sheets. Is there a limitation to Application.Run that it only allows certain code or there's an error that Excel is not giving me?
I get the same thing when I run your code. I tried a few different tweaks and am able to enter debug/breakpoint mode if I do this:
Sub t()
Dim sht As Worksheet
Dim macro As String
For Each sht In ThisWorkbook.Worksheets
sht.Activate
macro = sht.CodeName & ".Harmoniser"
Application.Run macro
Next
End Sub
Your code may have been erroring silently because you were using ActiveSheet without first Activating the sheet which contains the macro to be run. Not sure about the double-display of the MsgBox, but seems like that may be related.