I have thousands of cells in a column which all have a phone number formatted as
You do not need Regex for this. If your data is in column A and consists of constants (not formulas) then:
Sub NoRegex()
Dim r As Range
Set r = Columns(1).SpecialCells(2)
r.Replace what:="(", replacement:=""
r.Replace what:=")", replacement:="-"
End Sub
Related
I am in need of help with looping through a range (In this case Column "C") and finding 5 specific words (Sort, Set, Shine, Standardize, and Sustain) and then offsetting one row below the found value and copying that value to a categorized list on another sheet. To add complexity eliminating duplicate comments and blanks if possible would be great!
This is an imported form to my workbook and i am trying to create a quickly generated list of each comment under each specific word so that i can then copy into a report.
This code is borrowed and i am in need to adding multiple strings to find and be listed under each category.
Code:`Sub Find_Range()
'
Dim strFind As String
Dim oRng As Range
Dim fRng As Range
Dim i As Long
strFind = "SET IN ORDER" ' string to find
Set oRng = Worksheets("IMPORTED DATA").Columns(3) ' column to search
Set fRng = oRng.Cells(oRng.Cells.Count)
For i = 1 To Application.CountIf(oRng, strFind & "*")
Set fRng = oRng.Cells.Find(What:=strFind, _
LookIn:=xlValues, _
LookAt:=xlPart, _
After:=fRng, _
MatchCase:=False)
If Not fRng Is Nothing Then
With Worksheets("5S COMMENTS")
.Cells(i, "A") = fRng.Offset(1, 0).Value2
'.Cells(i, "B") = fRng.Offset(2, 1).Value2
End With
End If
Next i
'
End Sub`
Any help would be greatly appreciated!!!
Picture of excel list
Instead of VBA I suggest to use a formula:
=LET(
Source; 'Imported data'!C1:C999;
Step; 3;
FirstRow; INDEX(ROW(Source);1;0);
Criteria; FILTER(Source; MOD(ROW(Source)-FirstRow; Step) = 0);
Data; FILTER(Source; MOD(ROW(Source)-FirstRow; Step) = 1);
FILTER(Data; Criteria = INDIRECT("R[-1]C";FALSE)))
Here:
Source is a range with data to filter, where the first cell should be the one to check for the specific words
Step is a data chunk size, which is 3 in your case I guess
Criteria is cells to check for specific words
Data is the Criteria shifted one row down
INDIRECT("R[-1]C", False) addresses a cell right above the formula
Put the formula under the word to search for
I am a VBA newbie here. Ideally, I would like to put together a macro that will scan a specific column for certain Chinese phrases and translate them per a list of translations.
I've started with kind of a primitive find and replace via an Activecell.value loop per my friend's suggestion, but it won't work because VBA doesn't allow for Chinese characters.
sub Translate()
ActiveCell.Select ("A2")
Dim r As Integer ' Number of rows
' ****************************** Input ******************************
' Count rows "r" & Indent
' Use Loop
Do
r = r + 1
If ActiveCell.Value = "??" Then
ActiveCell.Value = "Apple"
Else
If ActiveCell.Value = "??" Then
ActiveCell.Value = "Banana"
End If
' Move Cursor
ActiveCell.Offset(0, 1).Select
' End Loop
Loop Until ActiveCell.Value = ""
End Sub
Here's the logic I would want the macro to follow:
select a specific column as range
check value of cell
if value of cell = specific Chinese phrase (likely from another sheet or index)
replace value with specified translation phrase
continue down the column until blank cell is reached, then end macro
For example,
A
1 **Fruit**
2 赛伍
3 香蕉
gets checked against reference sheet or index:
A B
1 赛伍 apple
2 香蕉 banana
so that the end result is:
A
1 **Fruit**
2 apple
3 banana
Any help you could provide would be greatly appreciated. Thank you!
Edit: I do not think my question is a duplicate to "declaring a unicode string in vba in excel" because ideally the macro would function based on reading cell values outside of the code
ex:
' if Sheet0!A2 matches Sheet1!A2, replace Sheet0!A2 with Sheet1!B2
Let's assume the two sheets are Sheet1 and Sheet2. You may use a for loop to iterate the cells of the first column on Sheet1 and then use the Range.Find method to look for a match in Sheet2.
Try something like this:
Option Explicit
Sub Test()
Dim lastRow As Long, i As Long
lastRow = Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp).Row
For i = 2 To lastRow
Dim currentCell As Range, foundChineseCell As Range, foundEnglishCell As Range
Set currentCell = Sheet1.Range("A" & i)
Set foundChineseCell = Sheet2.Range("A:A").Find(currentCell.Value)
If Not foundChineseCell Is Nothing Then
Set foundEnglishCell = foundChineseCell.Offset(0, 1)
currentCell.Value = foundEnglishCell.Value
End If
Next
End Sub
Result:
I'm new to VBA. I have a range of cells in column B with the format:
1###-2#-3##-4#
I want to enter a mid formula to get the last cell based on the fact that:
the next cell is empty
the cell matches the regex pattern
My code doesn't give me any errors but doesn't run.
Option Explicit
Sub DeptProgram()
Dim regex As String
Dim Pattern As String
Dim cell As Range
regex = "[0-9]{4}-[0-9]{2}-[0-9]{3}-[0-9]{2}"
For Each cell In Range("B1:B600")
If Pattern = regex And ActiveCell.Offset(1, 0) <> "" Then
ActiveCell.Offset(0, 2).Formula = "MID(B" & "activecell.Row.Offset(0,-2), 6, 11)"
End If
Next cell
End Sub
On another note: I used regex in VBA based on this article.
As per all the comments:
Option Explicit
Sub DeptProgram()
Dim cell As Range
For Each cell In Range("B1:B600")
if cell like "####-##-###-##" and cell.offset(1,0) = "" then
cell.Offset(2,0).Formula = "=MID(" & cell.Address & ", 6, 11)"
End If
Next cell
End Sub
After running:
I am attempting to use the following code to loop through a range of cells, searching for cells that contain ="":
Sub ReplaceEmptyCells()
Dim i As String
Dim k As String
Dim cell As Range
i = "=" & Chr(34) & Chr(34)
k = "#N/A"
For Each cell In ActiveSheet.Range("C1:AA51") 'Desired range to search through
If cell.Value = i Then
cell.Replace What:=i, Replacement:=k, MatchCase:=True
End If
Next cell
End Sub
This value has been set manually on another sheet and the cells in question have been copied and pasted as a link (this was done so as to avoid the empty cells being converted to 0s after the paste, while maintaining 0s in the original data).
The intent is for the content of the "blank" cells on the new sheet to be "#N/A". Why doesn't the above Sub work?
Why loop when you can just use:
ActiveSheet.Range("C1:AA51").Replace What:=i, Replacement:=k, Lookat:=xlWhole
When debugging or Quality Checking an Excel report at work I have found that the problem was because of text being hard coded inside a formula. I have heard this as being a Constant and Formula mixed cell.
Here are examples of what I see.
Constant =100
Constant =Facility
Formula cell =INDIRECT(ADDRESS(5,MATCH($A7&$B7&C$2,Data!$4:$4,0),,,$A$2))
Mixed cell =INDIRECT("Data!"&ADDRESS(5,MATCH($A7&$B7&C$2,Data!$4:$4,0)))
"Data!" is the Constant in the mixed cell, in this case the sheet name. If that sheet name ever changed, the formula would break. I have found and am using two conditional formats to highlight cells that are Constants and those that are formulas using this "Identify formulas using Conditional Formatting". I need to come up with a way to format those cells which contain these Constants inside of formulas.
I have found this question and tried using =IF(COUNT(SEARCH(CHAR(34),A1,1)),TRUE,FALSE) and FIND() to see if I could check if a cell had double quotes inside of it, but the SEARCH() returns FALSE since it is looking at the cells value and not it's contents. It returns TRUE if the cell contains "Constant" but if it is a formula it returns FALSE, such as if the cell contains ="Constant".
How can I find Constants inside formulas across a whole worksheet or workbook?
EDIT*
Thanks to Sidd's code below I have made a function in a module I can use in conditional formatting to at least highlight cells that contain quotes inside the cells.
Function FormulaHasQuotes(aCell)
If InStr(1, aCell.Formula, """") Then
FormulaHasQuotes = True
Else
FormulaHasQuotes = False
End If
End Function
Let's say your sheet looks like this.
Is this what you are trying?
Sub Sample()
Dim ws As Worksheet
Dim aCell As Range, FRange As Range
'~~> Set this to the relevant sheet
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
'~~> Find all the cells which have formula
On Error Resume Next
Set FRange = .Cells.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
If Not FRange Is Nothing Then
'~~> Check for " in the cell's formula
For Each aCell In FRange
If InStr(1, aCell.Formula, """") Then
Debug.Print "Cell " & aCell.Address; " has a constant"
End If
Next
End If
End With
End Sub
When you run the above code, you get this output
Cell $A$2 has a constant
Cell $A$5 has a constant
Note: I have shown you how to do it for a sheet, i am sure you can replicate it for all sheets in a workbook?
Only very lightly tested...
For example will not handle "string" constants which contain embedded "
Sub Tester()
'add reference to "Microsoft VBScript Regular Expressions 5.5"
Dim regxnum As New RegExp, regexpchar As New RegExp
Dim matches As MatchCollection, m As Match
Dim rngF As Range, c As Range
On Error Resume Next
Set rngF = ActiveSheet.UsedRange.SpecialCells(xlFormulas)
On Error GoTo 0
If Not rngF Is Nothing Then
regxnum.Pattern = "[^A-Z$](-?\d{1,}\.?\d{0,})"
regxnum.Global = True
regexpchar.Pattern = "(""[^""]{0,}"")"
regexpchar.Global = True
For Each c In rngF.Cells
Debug.Print c.Formula
Set matches = regxnum.Execute(c.Formula)
For Each m In matches
Debug.Print c.Parent.Name, c.Address(), m.SubMatches(0)
Next m
Set matches = regexpchar.Execute(c.Formula)
For Each m In matches
Debug.Print c.Parent.Name, c.Address(), m.SubMatches(0)
Next m
Next c
End If
End Sub