So I have a customer that need a specific code isolated from the name of each location. I have the following formula that I have been manually editing, but was wondering if there is a way to have it possibly count the characters in a cell and pull the codes to a new cell.
Example Location Name: MRI-LENOX HILL RADIOLOGY 150/14101
=RIGHT(A1,FIND("/",A1)-19)
The code format is 0123/01234 (3 to 4 characters in front of the slash and 5 after)
Any help in this regard would be much appreciated.
Thanks,
Justin Hames
You can use a regex to find and extract the code from the cell value. For example:
With CreateObject("VBScript.RegExp")
.Pattern = "\d{3,4}/\d{5}"
If .Test(Range("A1")) Then
Range("B1") = .Execute(Range("A1"))(0)
End If
End With
This will extract the code from A1 and place it into B1.
Edit, with respect to comments:
To run on a range of cells:
Dim re
Set re = CreateObject("VBScript.RegExp")
re.Pattern = "\d{3,4}/\d{5}"
Dim r As Range
For Each r In Range("A1:A100")
If re.Test(r) Then r.Offset(0, 1) = re.Execute(r)(0)
Next
Related
In a workbook I have, the D column has a formula in it to derive the last six digits of a value in column C. These columns are located in a sheet titled "JE". I have a dynamic SQL connected query that has values in the A column. That query is located in a sheet titled "required_refs". I essentially, want to write: If the value in the D column cell matches/equals any of the values in that query in sheet "required_refs", turn the F column cell red in sheet JE.
Example: If cell D10 has a value that equals any of the values in column A in "required_refs", turn cell F10 red. In addition, if cell D13 has a value that matches/equals a value in column A in sheet "required_refs", turn F13 red. And so on.
Here is the code I tried. I added it in Sheet "JE":
Code:
Sub ChangeCellColor()
Dim ref_code As Range: Set ref_code = Range("D7:D446").Value
Dim refCode_Confirm As Range: Set refCode_Confirm = Worksheets("required_refs").Range("A:A").Value
Dim colorChange As Range: Set colorChange = Worksheets("required_refs").Range("A:A")
For Each cell In ref_code
If cell.Value = refCode_Confirm.Value Then
Range("F7:F446").ActiveCell.Interior.ColorIndex = 3
Next cell
End If
End Sub
Currently, this code just doesn't do anything. It doesn't turn the F column cell red. I've asked a question similar to this but, the workbook I'm using has changed a bunch since then, and this question is a bit more simple than the previous one.
If anyone could help, I'd really appreciate it. Thanks!
Your code has a number of issues.
.Value returns a basic type, like a string or long. You can't assign this to a range variable.
Your End If and Next cell statements are swapped around. Always use correct indentation so these errors become more obvious.
You have an undeclared variable cell. This can potentially cause bugs. In the VBE, turn on the Tools > Options > Editor > Required Variable Declaration option to force the use of Option Explicit in new modules.
Fixing these issues leads us to this:
Sub ChangeCellColor()
Dim cell As Range
Dim ref_code As Range: Set ref_code = Range("D7:D446")
Dim refCode_Confirm As Range: Set refCode_Confirm = Worksheets("required_refs").Range("A:A")
Dim colorChange As Range: Set colorChange = Worksheets("required_refs").Range("A:A")
For Each cell In ref_code
If cell.Value = refCode_Confirm.Value Then
Range("F7:F446").ActiveCell.Interior.ColorIndex = 3
End If
Next cell
End Sub
Unfortunately, it still doesn't work as you can't compare a single value directly against a column of values in VBA.
This following code corrects this remaining issue. Note the choosing of good meaningful names as well as the use of RVBA for the variables. This is a good tip for how to avoid making similar errors. Also note the use of .Value2 instead of .Value. This is highly recommended.
Sub ChangeCellColor()
Dim rngRef As Range
Dim rngRefsToCheck As Range: Set rngRefsToCheck = Range("D7:D446")
Dim rngRequiredRefs As Range: Set rngRequiredRefs = Worksheets("required_refs").Columns("A")
Dim rngColorChangeRequired As Range: Set rngColorChangeRequired = Columns("F")
For Each rngRef In rngRefsToCheck
If Not IsError(Application.Match(rngRef.Value2, rngRequiredRefs, 0)) Then
rngColorChangeRequired.Cells(rngRef.Row).Interior.ColorIndex = 3
End If
Next rngRef
End Sub
The best and fastest way to achieve the color change would be to use Advanced Filters, thus avoiding the need to loop. However, since you're still learning the basics, I've shown the looping version.
I have column header which I want to split
Heading
XA 2009
WW YY 2010
XXA 2011
I Want output like
XA,
WW YY,
XXA
Earlier I was using find function in excel which was working fine
=MID("XA 2009",1,FIND(" ","XA 2009",FIND(" ","XA 2009")+1)-1)
OUTPUT AS XA,
WW YY
Now requirement has change to code in vba
I was trying to use Instr() instead of find as it is not working in VBA
Mid("XA 2009", 1, InStr(1, "XA 2009", " ", InStr(1, "XA 2009", "2")) - 1)
Now the output is XA,
WW instead of WW YY.
Can anyone suggest what I am doing wrong. I am pretty new to vba.
I Want output like
XA,
WW YY,
XXA
I am using excel 2013
First, see in the answer for the following SO question, the general approach and prerequisites for using Regex search in VBA:
How to use Regular Expressions (Regex) in Microsoft Excel both in-cell and loops
Now, as for your specific requirement, try the following pattern:
(\D*)\s+\d*\s+(\D*)\s+\d*\s+(\D*)\s+\d*
It will work for your precise example, but if you need the input string to be a bit more general you might need to modify the pattern.
Some explanations:
\D* will match one or more non numerical text characters ("alpha character")
\s+ will match at least one space character
\d* will match one or more numerical digits
the (parenthesis) are for grouping sets of results, so I used them to surround what you wish to extract from the input string.
If for example you know for sure that there's only one white-space character you can use:
[\s]
So the pattern might look like:
(\D*)[\s]\d*[\s](\D*)[\s]\d*[\s](\D*)[\s]\d*
Also, this is a great tool for online pattern testing:
https://regex101.com/
This is the solution for your edited requirement:
In the VBA editor, go to tools=>references, find and select the checkbox next to "Microsoft VBScript Regular Expressions 5.5", press ok
add this code to "ThisWorkbook" module:
Private Sub solution()
Dim regEx As New RegExp
Dim strPattern As String
Dim myInput As Range
Dim myOutput As Range
Set myInput = ActiveSheet.Range("A1")
Set myOutput = ActiveSheet.Range("A2")
strPattern = "(\D*)[\s]\d*[\s](\D*)[\s]\d*[\s](\D*)[\s]\d*"
strInput = myInput.Value
With regEx
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = strPattern
End With
If regEx.test(strInput) Then
ActiveSheet.Range("A2") = regEx.Replace(strInput, "$1, $2, $3")
End If
End Sub
You probably had that formula in a specific cell, right? I think the following should do:
Range("yourcell").FormulaR1C1 = "=MID("XA 2009",1,FIND(" ","XA 2009",FIND(" ","XA 2009")+1)-1)"
Just replace "yourcell" with the cell number you had the formula in. So if you had it in cell A1, for example, it should be Range("A1")
I'm a novice when it comes to VBA, Macros and Modules, so please include specific steps. How do I delete duplicate phrases from a single cell, such as the following:
"Brotherhood Of Man - United We Stand Brotherhood Of Man - United We Stand"
I want to be left with:
"Brotherhood Of Man - United We Stand"
You can use a regex with a backreference to match duplicated words or phrases. The pattern ^(.+)\s*\1$ will match any duplicating phrase with optional whitespace in between.
Const strText = "Brotherhood Of Man - United We Stand Brotherhood Of Man - United We Stand"
Dim re
Set re = CreateObject("VBScript.RegExp")
re.Pattern = "^(.+)\s*\1$"
If re.Test(strText) Then
Debug.Print re.Replace(strText, "$1")
End If
Output:
Brotherhood Of Man - United We Stand
Edit, with respect to comments:
To check every cell in column A, add a subroutine to your worksheet that iterates each cell and sends the cell value to the regex parser. For example, to run it for the range A1:A100:
Sub UpdateCells()
' Create our regex. This will never change, so do it up front.
Dim re
Set re = CreateObject("VBScript.RegExp")
re.Pattern = "^(.+)\s*\1$"
' Check every cell in a particular range.
Dim r As Range
For Each r In Range("A1:A100")
If re.Test(r) Then
r = re.Replace(r, "$1")
End If
Next
End Sub
I am a total newbie in Excel VBA. I find a script that can help me map data from one worksheet to another, but after the mapping is done, the value format just changed.
I have two sheets, Sheet 1 is the raw data sheet, and Master Data sheet is where the mapping data are stored. Please see the table structures below:
Sheet 1:
Description:
Home Use
Business Owner
Professional
CFO
Secretary
Master Data sheet:
code Description
001 Home Use
002 Business Owner
003 Professional
004 CFO
005 Secretary
As you may see the values in the first column in the Master Data sheet are in text format, ie 001, 002, etc
The code below does the trick to map the data in the first column in Master Data sheet and use them to replace the description in Sheet 1.
Sub mapping()
Dim rng1 As Range, rng2 As Range, cel As Range
Dim StrMyChar As String, StrMyReplace As String
With ActiveWorkbook.Worksheets("Master Data")
Set rng1 = .[B1:B5]
End With
With ActiveWorkbook.Worksheets("Sheet1")
Set rng2 = .[A2:A6]
End With
'loop down list of texts needing replacing
For Each cel In rng1.Cells
StrMyChar = cel.Value
StrMyReplace = cel.Offset(0, -1).Value
'replace text
With rng2
.Replace What:=StrMyChar, Replacement:=StrMyReplace,_
SearchOrder:=xlByColumns, MatchCase:=False
End With
'Next word/text to replace
Next cel
End Sub
After running the code, I find all the 001, 002, etc all got changed to 1, 2, etc.
Is there a way for me to preserve the 001 string format?
Thanks.
Try this below. Note that it still forces the replacement format, so that the values in the cells are still technically numbers. This is a drawback of Excel's replace functionality--its just how it works because it wants to assume that everything is numeric.
Note that you also had the rng1 set to the wrong range, it should be b2-b6 not b1-b5
With ActiveWorkbook.Worksheets("Master Data")
Set rng1 = .[B2:B6] ' Note that you had the wrong range here
End With
'this will force two leading zeros if necessary call it before the replace
Application.ReplaceFormat.NumberFormat = "00#"
'then add ReplaceFormat:=true to your replace string
.Replace What:=StrMyChar, Replacement:=StrMyReplace, _
SearchOrder:=xlByColumns, MatchCase:=False, ReplaceFormat:=True
Unfortunately ReplaceFormat.NumberFormat = "#" does not work with Excel's built in replace. The better option if we don't want to mess with Excel's built in replace method, we can do it ourselves, quick and easy:
Option Compare Text 'use this for case insensitive comparisons
Sub Mapping()
Dim rngLookup As Range
Set rngLookup = ActiveWorkbook.Worksheets("Master Data").[B2:B6]
Dim rngReplace As Range
Set rngReplace = ActiveWorkbook.Worksheets("Sheet1").[A2:A6]
Dim cell As Range, cellLookup As Range
For Each cell In rngReplace
Dim val As String
val = cell.Value
For Each cellLookup In rngLookup
If cellLookup.Value = val Then
cell.NumberFormat = "#"
cell.Value = cellLookup.Offset(0, -1).Value
Exit For
End If
Next
Next
End Sub
This code loops through each line in your Sheet 1, and then searches for the proper entry in the master sheet, but sets the Number Format to "#" before it copies it. You should be good.
If you are going to have to work with a LOT of cells, consider turning Application.ScreenUpdating off before running the procedure, and back on after. This will speed things up as it doesn't have to worry about rendering to the screen while it is working.
Another, non VBA idea that keeps both the original value and adds data next to it:
You could also get this information (albeit in a different column) using a Vlookup without any VBA code. If you switch your Descriptions to Column A and your Codes to Column B on the Master Sheet, you can then go to Sheet1, highlight the cells in Column B and type this formula:
=VLOOKUP(A2:A6,'Master Data'!A2:B6,2,FALSE)
Do not hit enter, but rather hit Control+Shift+Enter. This creates what is called an Array formula. This doesn't do a replace for you, but offers the data in the column next to it. Just throwing this out there as some extra information if you needed another way of getting it.
You could also set the formula for a cell in VBA using the Range.Formula property and setting it to the vlookup formula above
I have a small script in Excel/VB that I'm trying to get working. All I want to do is select a dynamic range of data to copy but I can't seem to find any help/code on how to get the grid data (like A11).
Here is code I have from macro recording that selects the range of data:
Range("D291:D380").Select
I was hoping I could just do Range(Current).Select or something but that doesn't work.
How do I get the current cell using VBA?
Have you tried:
For one cell:
ActiveCell.Select
For multiple selected cells:
Selection.Range
For example:
Dim rng As Range
Set rng = Range(Selection.Address)
This may not help answer your question directly but is something I have found useful when trying to work with dynamic ranges that may help you out.
Suppose in your worksheet you have the numbers 100 to 108 in cells A1:C3:
A B C
1 100 101 102
2 103 104 105
3 106 107 108
Then to select all the cells you can use the CurrentRegion property:
Sub SelectRange()
Dim dynamicRange As Range
Set dynamicRange = Range("A1").CurrentRegion
End Sub
The advantage of this is that if you add new rows or columns to your block of numbers (e.g. 109, 110, 111) then the CurrentRegion will always reference the enlarged range (in this case A1:C4).
I have used CurrentRegion quite a bit in my VBA code and find it is most useful when working with dynmacially sized ranges. Also it avoids having to hard code ranges in your code.
As a final note, in my code you will see that I used A1 as the reference cell for CurrentRegion. It will also work no matter which cell you reference (try: replacing A1 with B2 for example). The reason is that CurrentRegion will select all contiguous cells based on the reference cell.
The keyword "Selection" is already a vba Range object so you can use it directly, and you don't have to select cells to copy, for example you can be on Sheet1 and issue these commands:
ThisWorkbook.worksheets("sheet2").Range("namedRange_or_address").Copy
ThisWorkbook.worksheets("sheet1").Range("namedRange_or_address").Paste
If it is a multiple selection you should use the Area object in a for loop:
Dim a as Range
For Each a in ActiveSheet.Selection.Areas
a.Copy
ThisWorkbook.worksheets("sheet2").Range("A1").Paste
Next
Regards
Thomas
If you're trying to grab a range with a dynamically generated string, then you just have to build the string like this:
Range(firstcol & firstrow & ":" & secondcol & secondrow).Select
I realize this doesn't directly apply from the title of the question, However some ways to deal with a variable range could be to select the range each time the code runs -- especially if you are interested in a user-selected range. If you are interested in that option, you can use the Application.InputBox (official documentation page here). One of the optional variables is 'type'. If the type is set equal to 8, the InputBox also has an excel-style range selection option. An example of how to use it in code would be:
Dim rng as Range
Set rng = Application.InputBox(Prompt:= "Please select a range", Type:=8)
Note:
If you assign the InputBox value to a none-range variable (without the Set keyword), instead of the ranges, the values from the ranges will be assigned, as in the code below (although selecting multiple ranges in this situation may require the values to be assigned to a variant):
Dim str as String
str = Application.InputBox(Prompt:= "Please select a range", Type:=8)
Try this
Dim app As Excel.Application = Nothing
Dim Active_Cell As Excel.Range = Nothing
Try
app = CType(Marshal.GetActiveObject("Excel.Application"), Excel.Application)
Active_Cell = app.ActiveCell
Catch ex As Exception
MsgBox(ex.Message)
Exit Sub
End Try
' .address will return the cell reference :)