Can someone help me fix the following code. I am trying to modify the first cell from the user's selection, so that it is absolute to the column only. (i.e. $A$1 to become $A1).
When using the below Replace function, it replaces both $ signs rather than just the 2nd...
var_address = Selection.Address
first_cell = Range(var_address).Cells(1, 1).Address
first_cell_new = Replace(first_cell, "$", "", Start:=2, Count:=1)
The Replace(..., Start:=n, ...) function removes the first n characters regardless what the function searches for.
Example:
Debug.Assert Replace("ABCDEF", "KLM", "XYZ", Start:=4) = "DEF"
Debug.Assert Replace("$AB$CD$EF", "$", "", Start:=4, Count:=1) = "CD$EF"
Debug.Assert Replace("$AB$CD$EF", "$", "", Start:=4, Count:=2) = "CDEF"
For your purpose, you need to combine Left and Replace functions:
var_address = "$A$1"
Debug.Print Left(var_address, 2) & Replace(var_address, "$", "", Start:=3) ' Count:=1 is useless here
See also Microsoft VBA documentation.
https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/replace-function
Well, after you clarification in a comment under my previous answer, it's now more clearer. You actually want to change absolute addresses (e.g. $A$1) relative one (e.g. $A1, A$1 or A1).
To do this, simply use the Address function and its parameters
var_address = Selection.Address
first_cell = Range(var_address).Cells(1, 1).Address(False, True)
Related
I'm trying to find and replace a string with double quotation marks, a comma and a colon, but I'm getting a error, I thought it was easier then it looks, but sadly I'm wrong.
What I tried so far is:
Cells.Replace What:=""Gorilla": "",", Replacement:=""Gorilla": """, LookAt:=xlPart
So the word/string I want to replace is "Gorilla": "",
The expected outcome should be "Gorilla": "" The difference is this one is (without comma)
EDIT: (to make my question more clear)
*The yellow and green highlighted parts mean nothing and is just for example purposes.
*Everything happens in column A, column D is just for example purposes.
The data looks like this in the screenshot. I have to search for the exact same string "Gorilla": "", to replace it with "Gorilla": "".
There isn't really an order in which row this part "Gorilla": "" can be, it can be on any row, but the string stays the same.
Assuming the start and end characters of your target string is always double quotes, then this custom function should work. You could include this in your macro if it's part of some other procedure.
Function fixString(theString As String) As String
Const startText As String = """"
Const endText As String = """"
Dim startPlace As Long, endPlace As Long
startPlace = InStr(1, theString, startText)
endPlace = InStrRev(theString, endText, -1)
fixString = Mid(theString, startPlace, endPlace)
End Function
Solution provided by: #chris neilsen
Solution:
What:="""Gorilla"": """",", Replacement:="""Gorilla"": """""
Solution in code:
Cells.Replace What:="""Gorilla"": """",", Replacement:="""Gorilla"": """"", LookAt:=xlPart
Background:
I have an Excel sheet with four columns (title, URL, status, type).
The table is a mix of text from various users who use different separators in the column title:
hyphen (surface-air-temperature)
underscore (latent_heat_flux)
plus and blank (+land surface elevation+)
point and blank (,Total cloud cover)
Problem:
The in-built customized sorting works up to a certain point. Unfortunately it does not target the ending of each entry (examples above).
Desired solution:
I would like to select a specific text as criteria for the sorting.
Before:
After:
Possible approach:
I have been thinking about splitting the rows. Unfortunately I cannot specify/customize the splitting. Would it be possible to write a script that allows "cut" the text at a specified point (e.g. that -mean-sea-level-pressure is separated from the rest and displayed in another column)?
CLIM-PRO-CMIP-SINGLE-XXXX-M-HISTORICAL-mean-sea-level-pressure
Another obstacle might be that different separators have been used.
Before splitting:
After splitting:
Try this function
Function EXTRACT_SORT_KEYWORDS(INPUT_TEXT As String) As String
Application.Volatile
Dim vSeparators As Variant
Dim vKeywords As Variant
Dim v As Variant
EXTRACT_SORT_KEYWORDS = ""
If Len(INPUT_TEXT) = 0 Then Exit Function
' Add more separators here
vSeparators = Array(" ", ";", ",", "-", "_")
' Add more keywords here. Note the line continuations
vKeywords = Array("mean sea level pressure", _
"surface air temperature", _
"latent heat flux", _
"land surface elevation", _
"land surface elevation", _
"total cloud cover", _
"cloud cover", _
"mean precipitation flux" _
)
For Each v In vSeparators
If v <> " " And InStr(1, INPUT_TEXT, v, vbTextCompare) > 0 Then
INPUT_TEXT = Replace(INPUT_TEXT, v, " ")
End If
Next v
INPUT_TEXT = Trim$(INPUT_TEXT)
For Each v In vKeywords
If InStr(1, INPUT_TEXT, v, vbTextCompare) > 0 Then
EXTRACT_SORT_KEYWORDS = v
Exit Function
End If
Next v
End Function
As your data grows, it is not a good idea to have many user defined functions in you sheets as they will slow down your application considerably. A better solution is to have code that generates this column dynamically, performs the sort and then delete the column.
Hope this helps.
I have the following Excel table used to calculate the overtime hours worked.
I want the last two columns to be auto-generated, preferably with formulas, so that the user can see on which dates the employees have worked OT.
The example output for Bob would be:
Dates worked Normal OT : "2nd, 3rd, 4th, 5th, 10th & 12th"
Dates worked Double OT : "6th, 7th & 13th"
Please note that I don't have Excel 2016, and therefore can't use TEXTJOIN(). Also note that the dates for Week 1 and Week 2 are stored in number format, not date format, so the use of WEEKDAY() is also not possible.
P.S. I have already tried a TextJoin UDF but it doesn't seem to work since I have a lot of criteria within the formula.
The working formula for TEXTJOIN in Excel 2016 is this:
=TEXTJOIN(", ",TRUE,IF(WEEKDAY($B$3:$O$3,2)<6,IF($B5:$O5>0,TEXT($B$3:$O$3,"dd/mm/yyyy"),""),""))
This is using date formats. The UDF doesn't seem to work with these parameters.
I am ignoring everything in the PS at the end of your question as Jeeped is right in that it is contradictory to the main body and screenshot.
Without using a UDF, the formula would be much too complicated. Don't worry, I have supplied my own basic TEXTJOIN() UDF that definitely works.
All the following formulae need to be "array-entered" (by pressed Ctrl+Shift+Enter) in a single cell, and then copied/filled down. (Remember not to copy the starting { and ending }.)
The only difference in the two formulae is that one uses the comparison <5 whilst the other uses >=5, and each one refers to the appropriate "No. of Days" cell.
This first formula needs to be array-entered into cell T5 (Bob's "Dates Worked Normal OT") and then filled down:
{=SUBSTITUTE(TEXTJOIN(", ", TRUE, IF((MOD(COLUMN($B5:$O5)-COLUMN($B5), 7)<5)*($B5:$O5>0), $B$3:$O$3 & CHOOSE(IF($B$3:$O$3<4, $B$3:$O$3, IF($B$3:$O$3<21, 4, IF($B$3:$O$3<24, $B$3:$O$3-20, IF($B$3:$O$3<31, 4, 1)))), "st", "nd", "rd", "th"), "")), ", ", " & ", MAX(1, S5-1))}
The expanded, easier to read, version of the above formula (it will also work if you copy-paste it):
{=
SUBSTITUTE(
TEXTJOIN(
", ",
TRUE,
IF(
(MOD(COLUMN($B5:$O5)-COLUMN($B5), 7)<5)*($B5:$O5>0),
$B$3:$O$3
&
CHOOSE(
IF($B$3:$O$3<4, $B$3:$O$3, IF($B$3:$O$3<21, 4, IF($B$3:$O$3<24, $B$3:$O$3-20, IF($B$3:$O$3<31, 4, 1)))),
"st", "nd", "rd", "th"
),
""
)
),
", ",
" & ",
MAX(1, R5-1)
)}
This second formula needs to be array-entered into cell U5 (Bob's "Dates Worked Double OT") and then filled down:
{=SUBSTITUTE(TEXTJOIN(", ", TRUE, IF((MOD(COLUMN($B5:$O5)-COLUMN($B5), 7)>=5)*($B5:$O5>0), $B$3:$O$3 & CHOOSE(IF($B$3:$O$3<4, $B$3:$O$3, IF($B$3:$O$3<21, 4, IF($B$3:$O$3<24, $B$3:$O$3-20, IF($B$3:$O$3<31, 4, 1)))), "st", "nd", "rd", "th"), "")), ", ", " & ", MAX(1, S5-1))}
The expanded version of the above formula is:
{=
SUBSTITUTE(
TEXTJOIN(
", ",
TRUE,
IF(
(MOD(COLUMN($B5:$O5)-COLUMN($B5), 7)>=5)*($B5:$O5>0),
$B$3:$O$3
&
CHOOSE(
IF($B$3:$O$3<4, $B$3:$O$3, IF($B$3:$O$3<21, 4, IF($B$3:$O$3<24, $B$3:$O$3-20, IF($B$3:$O$3<31, 4, 1)))),
"st", "nd", "rd", "th"
),
""
)
),
", ",
" & ",
MAX(1, S5-1)
)}
Notes:
As mention above, the formulae rely on the availability/accuracy of the "No. of Days" cells in order to work correctly.
These formulae are pretty straightforward:
(MOD(COLUMN($B5:$O5)-COLUMN($B5), 7)>=5)*($B5:$O5>0) is just an array-formula friendly way of writing AND((…), (…));
The only sneaky thing is the use of the CHOOSE() function with four nested IF()s to select the ordinal indicator.
Don't forget to not include the { at the start, and the } at the end of the formulae when copy-pasting. These are just used to show that a formula needs to be array-entered.
My version of the TEXTJOIN UDF:
'============================================================================================
' Module : <any standard module>
' Version : 0.1.0
' Part : 1 of 1
' References : Optional - Microsoft VBScript Regular Expressions 5.5 [VBScript_RegExp_55]
' Source : https://stackoverflow.com/a/49218794/1961728
'============================================================================================
Public Function TEXTJOIN( _
ByRef delimiter As String, _
ByRef ignore_empty As Boolean, _
ByRef text1 As Variant _
) _
As String
Dim ƒ As Excel.WorksheetFunction: Set ƒ = Excel.WorksheetFunction
Const DELIMITER_ As String = "#"
Const PATTERN_ As String = "^(?:#)+|(?:#)+$|(#){2,}"
Static rexDelimiterEscaper As Object ' VBScript_RegExp_55.RegExp ' ## Object
Static rexEmptyIgnorer As Object ' VBScript_RegExp_55.RegExp ' ## Object
If rexEmptyIgnorer Is Nothing _
Then
Set rexEmptyIgnorer = CreateObject("VBScript.RegExp") ' New VBScript_RegExp_55.RegExp ' ## CreateObject("VBScript.RegExp")
With rexEmptyIgnorer
.Global = True
.Pattern = PATTERN_ ' Replacement = "$1"
End With
Set rexDelimiterEscaper = CreateObject("VBScript.RegExp") ' New VBScript_RegExp_55.RegExp ' ## CreateObject("VBScript.RegExp")
With rexDelimiterEscaper
.Global = True
.Pattern = "(.)" ' Replacement = "\$1"
End With
End If
Dim varText1 As Variant
Select Case TypeName(text1)
Case "Range":
varText1 = ƒ.Transpose(text1.Value2)
If text1.Rows.Count = 1 Then
varText1 = ƒ.Transpose(varText1)
If text1.Columns.Count = 1 Then varText1 = Array(varText1)
End If
Case "Variant()":
varText1 = text1
Case Else:
varText1 = Array(text1)
End Select
If ignore_empty _
Then
With rexEmptyIgnorer
.Pattern = Replace(PATTERN_, DELIMITER_, rexDelimiterEscaper.Replace(delimiter, "\$1"))
TEXTJOIN = .Replace(Join(varText1, delimiter), "$1")
End With
Else
TEXTJOIN = Join(varText1, delimiter)
End If
End Function
Notes:
This is not a proper poly-fill:
The first two arguments are not optional;
If you no not wish to use a delimiter, you must pass an empty string as the first parameter.
There is only one other (also required) argument allowed.
You can pass in anything for the third argument, except a multi-dimension array/range. Doing so will result in a #VALUE! error.
It should be very fast, especially for large inputs, as it doesn't use any loops. If you aren't ignoring empty values, it will be lightning fast. Ignoring them will be slower as a couple of regexes and an extra string manipulation have to be used as well.
In Microsoft Excel file, I have a text in rows that appears like this:
1. Rc8 {[%emt 0:00:05]} Rxc8 {[%emt 0:00:01]} 2. Rxc8 {[%emt 0:00:01]} Qxc8 {} 3. Qe7# 1-0
I need to remove any text appearing within the flower brackets { and }, including the brackets themselves.
In the above example, there are three instances of such flower brackets. But some rows might have more than that.
I tried =MID(LEFT(A2,FIND("}",A2)-1),FIND("{",A2)+1,LEN(A2))
This outputs to: {[%emt 0:00:05]}. As you see this is the very first instance of text between those flower brackets.
And if we use this to within SUBSTITUTE like this: =SUBSTITUTE(A2,MID(LEFT(A2,FIND("}",A2)),FIND("{",A2),LEN(A2)),"")
I get an output like this:
1. Rc8 Rxc8 {[%emt 0:00:01]} 2. Rxc8 {[%emt 0:00:01]} Qxc8 {} 3. Qe7# 1-0
If you have noticed, only one instance is removed. How do I make it work for all instances? thanks.
Highlight everything
Go to replace
enter {*} in text to replace
leave replace with blank
This should replace all flower brackets and anything in between them
It is not that easy without VBA, but there is still a way.
Either (as suggested by yu_ominae) just use a formula like this and auto-fill it:
=IFERROR(SUBSTITUTE(A2,MID(LEFT(A2,FIND("}",A2)),FIND("{",A2),LEN(A2)),""),A2)
Another way would be iterative calculations (go to options -> formulas -> check the "enable iterative calculations" button)
To do it now in one cell, you need 1 helper-cell (for my example we will use C1) and the use a formula like this in B2 and auto-fill down:
=IF($C$1,A2,IFERROR(SUBSTITUTE(B2,MID(LEFT(B2,FIND("}",B2)),FIND("{",B2),LEN(B2)),""),B2))
Put "1" in C1 and all formulas in B:B will show the values of A:A. Now go to C1 and hit the del-key several times (you will see the "{}"-parts disappearing) till all looks like you want it.
EDIT: To do it via VBA but without regex you can simply put this into a module:
Public Function DELBRC(ByVal str As String) As String
While InStr(str, "{") > 0 And InStr(str, "}") > InStr(str, "{")
str = Left(str, InStr(str, "{") - 1) & Mid(str, InStr(str, "}") + 1)
Wend
DELBRC = Trim(str)
End Function
and then in the worksheet directly use:
=DELBRC(A2)
If you still have any questions, just ask ;)
Try a user defined function. In VBA create a reference to "Microsoft VBScript Regular Expressions 5.5. Then add this code in a module.
Function RemoveTags(ByVal Value As String) As String
Dim rx As New RegExp
rx.Global = True
rx.Pattern = " ?{.*?}"
RemoveTags = Trim(rx.Replace(Value, ""))
End Function
On the worksheet in the cell enter: =RemoveTags(A1) or whatever the address is where you want to remove text.
If you want to test it in VBA:
Sub test()
Dim a As String
a = "Rc8 {[%emt 0:00:05]} Rxc8 {[%emt 0:00:01]}"
Debug.Print RemoveTags(a)
End Sub
Outputs "Rc8 Rxc8"
I'm trying to extract my parameters from my SQL query to build my xml for an SSRS report. I want to be able to copy/paste my SQL into Excel, look through the code and find all instances of '#' and the appropriate parameter attached to it. These paramaters will ultimately be copied and pasted to another sheet for further use. So for example:
where DateField between #FromDate and #ToDate
and (BalanceFiled between #BalanceFrom and #BalanceTo
OR BalancdField = #BalanceFrom)
I know I can use Instr to find the starting position of the first '#' in a line but how then do I go about extracting the rest of the parameter name (which varies) and also, in the first two lines of the example, finding the second parameter and extracting it's variable lenght? I've also tried using the .Find method which I've been able to copy the whole line over but not just the parameters.
I might approach this problem like so:
Remove characters that are not surrounded by spaces, but do not
belong. In your example, the parentheses need to be removed.
Split the text using the space as a delimiter.
For each element in the split array, check the first character.
If it is "#", then the parameter is found, and it is the entire value in that part of the array.
My user-defined function looks something like this:
Public Function GetParameters(ByRef rsSQL As String) As String
Dim sWords() As String
Dim s As Variant
Dim sResult As String
'remove parentheses and split at space
sWords = Split(Replace(Replace(rsSQL, ")", ""), "(", ""), " ")
'find parameters
For Each s In sWords
If Left$(s, 1) = "#" Then
sResult = sResult & s & ", "
End If
Next s
'remove extra comma from list
If sResult <> "" Then
sResult = Left$(sResult, Len(sResult) - 2)
End If
GetParameters = sResult
End Function