I need to find and replace hundreds of misnamed field names (cell names) in a large excel financial model. I'm trying to build this macro subroutine to find a given field name and replace it with the correct field name.
Sub FindReplaceFieldName()
Dim orgFieldName As String
Dim replFieldName As String
orgFieldName = "CAN"
replFieldName = "Canada"
Application.Goto Reference:=orgFieldName
With ActiveWorkbook.names(orgFieldName)
.Name = replFieldName
.RefersToR1C1 = "=Sheet1!(" & activeCell.row & ";" & activeCell.Column &")".Comment = ""
End With
ActiveWorkbook.Save
End Sub
The field name is found and replaced, but a Runtime error 1004 is thrown here
"=Sheet1!(" & activeCell.row & ";" & activeCell.Column &
")"
"The formula you typed contains an error." and so on.
I'm not familiar with VBA syntax, so a 2nd pair of experienced eyes would be helpful.
SOLVED: The correct syntax should be
.RefersToR1C1 = "=Sheet1!R" & activeCell.row & "C" & activeCell.Column & ""
Forgive me if wrong, but are you not approaching this sideways? You want to change the existing names not amend the locations; Ergo, use a mapping to rename the existing.
For example, use a dictionary to rename (you could use other structures); I wanted to leverage the .Exists of a dictionary so only attempted valid substitutions. You could even loop a range in the sheet to populate your dictionary. Or read the range straight into an array and dump the array into the dictionary as key/values.
Code:
Option Explicit
Public Sub RenameNamedRanges()
Dim currName As Name
Dim replaceDict As Object
Set replaceDict = CreateObject("Scripting.Dictionary")
replaceDict.Add "CAN", "Canada"
replaceDict.Add "FR", "France"
replaceDict.Add "DE", "Deutschland"
For Each currName In ThisWorkbook.Names
If replaceDict.Exists(currName.Name) Then
currName.Name = replaceDict(currName.Name)
End If
Next currName
End Sub
Before:
After:
To troubleshoot issues like this, where you're building a string to be used elsewhere, troubleshoot by looking at the problem string just before the error is caused.
In this case, you could add a line just before the line where you get the error:
Debug.Print "=Sheet1!(" & activeCell.row & ";" & activeCell.Column & ")"
...then, when you run your code and get the error, go to the Immediate Window (Ctrl+G) and see what Excel thinks you mean.
Are you able to see your error now?
That being said, you must have posted your code incorrectly, since I can't get it to run at all (to get an Error 1004) since this line is wonky:
.RefersToR1C1 = "=Sheet1!(" & activeCell.row & ";" & activeCell.Column &")".Comment = ""
If I replace the row and column numbers you're trying to insert with 1234 then it would read:
.RefersToR1C1 = "=Sheet1!(1234;1234)".Comment = ""
I can't give an absolute solution without knowing more about what you're trying to do, but obviously that is an invalid command (and likely not what you intended).
Note that ActiveCell.Row and ActiveCell.Column both return numbers, and that Sheet1!(1,1) is not how we refer to a cell in Excel.
Related
I am trying to search an entire row for a string that contains "PROFILE". It will always be capitalized, but the format will be, for example "[9]PROFILE001".
Some extra information: I have used the Find command to locate the row that I am searching in for the string. It has its own variable that I am trying to incorporate into the range I am using.
I have searched multiple partial string articles on here, and have not been able to implement it into my code. I have tried using the Like command and the IntStr command to no avail. I believe my issue may be with how im referencing the search range or how i am searching.
Here is a snippet of my current code:
'finding item name row
Set FindRow3 = Range("A1:A100").Find("Item Name", LookIn:=xlValues)
itemnamerow = FindRow3.Row
'The section above is working as intended
'searching for the word profile, the section below is the one I am having issues with
Range("B8:Z100").Style = "Normal"
If ActiveSheet.Range("B" & itemnamerow & ":Z" & itemnamerow) Like "*PROFILE" Then
Range("C1").Value = "it worked"
End If
I am currently experiencing a run time error 13, type mismatch in the "If ActiveSheet..." line. I have not been able to get the correct index to make this correct.
I am trying to use that if the partial string is found, I want do something.
TIA
You need to use the Find method, with MatchCase and LookIn arguments set. And probably LookAt for to ensure it checks actual values and not formula syntax.
Dim profileFound as Range
Set profileFound = ActiveSheet.Range("B" & itemnamerow & ":Z" & itemnamerow).Find("PROFILE",lookIn:=xlValues,MatchCase:=True,lookAt:=xlPart)
If Not profileFound is nothing Then
debug.print profileFound.Value
Range("C1").Value = "it worked"
else
debug.print "no profile found"
End If
The reason your original code is failing is because Excel will not allow you to evaluate a multi-cell range against a single value. You could loop through each cell in the range and check each cell individually, but since Find is available, that is superfluous.
You don't provide enough parameters for the Range.Find operation. Switch to the worksheet's Match to locate Item name then again as a wildcard search to locate profile.
dim m as variant, n as variant
m = application.match("Item Name", range("A1:A100"), 0)
If not iserror(m) then
n = application.match("*profile*", cells(m, "B").resize(1, 25), 0)
If not iserror(n) then
Range("C1").Value = "it worked " & cells(m, n+1).value
end if
end if
I am trying to write a VB script that concatenates data together into a url string and then I want it to copy down into all the rows for that column. I've got the fill down code working okay but when I try to add the concatenate I keep getting a syntax error so I'm not sure what I'm doing wrong. I have tried two versions and they both give me syntax errors on the final line of script (right side):
Script Version 1:
Sub SetSurveyLink()
' SetSurveyLink Macro
Dim lngLastRow As Long
lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("C3:C" & lngLastRow).Value = EVALUATE("https://domainname.com/survey/?PartName=" & 'Client List'!B1 & "&ClientID="&B2)
End Sub
Script Version 2:
Sub SetSurveyLink()
' SetSurveyLink Macro
Dim lngLastRow As Long
lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("C3:C" & lngLastRow).Value = CONCATENATE("https://domainname.com/survey/?PartName=",'Client List'!B1,"&ClientID=",B2)
End Sub
The 'concatenate' string gives me the correct value when used in a cell (i.e. not as part of a script) but I just can't get it to work in the script. See anything that I'm missing in my syntax?
THANK YOU!
Any double-quote marks within a string need to be escaped to be double double-quote marks so, if
"https://domainname.com/survey/?PartName=" & 'Client List'!B1 & "&ClientID="&B2
worked within Excel, it becomes
""https://domainname.com/survey/?PartName="" & 'Client List'!B1 & ""&ClientID=""&B2
and then you need to enclose that within double-quote marks to make it a string literal within VBA, i.e.
"""https://domainname.com/survey/?PartName="" & 'Client List'!B1 & ""&ClientID=""&B2"
I am trying to copy some 8-digit numbers to use in a SQL search.
The SQL query gave me errors and after some debugging I found that the string doesn't contain all the data. It seems that after 25 or so numbers my for loop stops entering data as if the string is full.
Thanks for the help...
Lots = ""
For iRow = 2 To 500
If IsEmpty(Sheets("Filtered Data").Cells(iRow, 2)) Then Exit For
Lots = Lots & ",'" & Sheets("Filtered Data").Cells(iRow, 2).value & "'"
Next iRow
Lots = "(" & Mid(Lots, 2, Len(Lots) - 1) & ")"
you should post your data raising the errors
as for while you can consider the following code to build-up the string exploiting Join() function
Dim Lots As String
With Worksheets("Filtered Data") '<--| change "Filtered Data" with your actual worksheet name
With .Range("B2", .Cells(.Rows.Count, 2).End(xlUp)) '<-- consider its column "B" cells from row 2 down to last non empty one
Lots = "('" & Join(Application.Transpose(.Value), "','") & "')" '<-- build up the string
End With
End With
this assumes that all non empty cells in column "B" are contiguous (i.e. non blank cells in between non blank ones), but it can be easily modified should this not be the case
Your code works fine. Presumably you have an empty cell in the column which is making it exit the loop....
I am working with a sheet with almost 200 named ranges (each column is a NR). I now would like to make them dynamic i.e. instead of defining them like
PersonID = =RawData!$A$2:$A$100
I want to do it this way
PersonID = OFFSET(RawData!$A$2,0,0,COUNTA(RawData!$A:$A),1)
But I do not want to do this manually! Is there a way to do this in a texteditor outside Excel or is there a way to do this programatically? I already have the 200 NRs done in the first way in place, but the thought of manually go through them all to change is scaring me.
You can do it in VBA. Example to create a new name:
ActiveWorkbook.Names.Add Name:="PersonID", _
RefersTo:="=OFFSET(RawData!$A$2,0,0,COUNTA(RawData!$A:$A),1)"
To edit an already existing name:
ActiveWorkbook.Names("PersonID").RefersTo = _
"=OFFSET(RawData!$A$2,0,1,COUNTA(RawData!$A:$A),1)"
You indicate in a comment that you would also like to iterate through all named ranges to facilitate changing their definition. To loop through all names you can do this:
Dim nm As Name
For Each nm In ActiveWorkbook.Names
Debug.Print nm.Name
Next nm
or this:
Dim i As Long
For i = 1 To ActiveWorkbook.Names.Count
Debug.Print ActiveWorkbook.Names.Item(i).Name
Next i
This seems to be a pretty good tool to have in your toolbox?
Sub MakeRangesDynamic()
Dim i As Long
For i = 1 To ActiveWorkbook.Names.Count
If Not (ActiveWorkbook.Names.Item(i).Name = "NameToExclude1" Xor _
ActiveWorkbook.Names.Item(i).Name = "NameToExclude2" Xor _
ActiveWorkbook.Names.Item(i).Name = "NameToExclude3") Then
FindTheColumn = Mid$(ActiveWorkbook.Names.Item(i).RefersTo, 11, 2)
If Mid$(FindTheColumn, 2, 1) = "$" Then
FindTheColumn = Mid$(FindTheColumn, 1, 1)
Else
FindTheColumn = Mid$(FindTheColumn, 1, 2)
End If
DynNameString = "=OFFSET(RawData!$" & FindTheColumn & "$2,0,0,COUNTA(RawData!$" & FindTheColumn & ":$" & FindTheColumn & "),1)"
Debug.Print DynNameString
'ActiveWorkbook.Names.Item(i).Name.RefersTo = DynNameString
End If
Next i
End Sub
A special thanks goes to Jean-Francois for helping me out.
Change the RawData to your sheetname and the NameToExclude to your ranges to leave untouched.
Remove the last comment for making it happen! But be sure to make a backup copy first!!!!
I am trying to get some text between two words from a column of similar data, so far I have:
Dim I As Integer
For I = 1 To 989
thisSTRING = Worksheets(1).Range("A" & I).Value
ref = Split(Split(thisSTRING, "RING ")(1), " EM")(0)
Worksheets(1).Range("B" & I).Value = ref
Next I
The problem I have is that not all text in the column is the same and when I reach such a point in the for loop I get an error message as there is either no "RING" or "EM", to avoid this I tried to use "on error resume next". This worked but it duplicates in the cells which had the errors. Is there any simple method for making this skip the cell/leave it blank instead of creating a duplicate?
Here's what I was thinking:
Sub PrintSplit()
Dim ws As Excel.Worksheet
Dim i As Long
Dim thisSTRING As String
Dim ref As String
Set ws = ThisWorkbook.Worksheets(1)
For i = 1 To 989
thisSTRING = ws.Range("A" & i).Value
If InStr(thisSTRING, "RING ") > 0 And InStr(thisSTRING, " EM") > 0 Then
ref = Split(Split(thisSTRING, "RING ")(1), " EM")(0)
ws.Range("B" & i).Value = ref
End If
Next i
End Sub
This assumes that you want a blank if either of the strings are missing. If you only wanted it if both strings are missing the logic would be different, but similar.
Note that I changed i to a Long which is a good practice, as it's the native type for whole numbers and will accommodate larger values. I also created a worksheet variable, just to make it a little more flexible, and to get Intellisense.