I am pretty new to VBA, and i need to make a loop that removes certain punctuation which is referenced as values A2:A33 on my spreadsheet, from a string. This is what I have so far, struggling with the replace function. Any help would be greatly appreciated thanks!
Function CleanDescription(rawDescription As String) As String
Dim punctuationRng As Range
Set punctuationRng = Worksheets("ToRemove").Range("A2:A33")
Dim cleanDesc As String
cleanDesc = rawDescription
For i = 1 To punctuationRng.Count
cleanDesc = Replace(cleanDesc, punctuationRng, "")
Next i
CleanDescription = cleanDesc
End Function
You can achieve substituting each value in a range of cells that is present in a string by a For Each:
Function CleanDescription(rawDescription As String) As String
Dim punctuationRng As Range
Set punctuationRng = Worksheets("ToRemove").Range("A2:A33")
Dim cleanDesc As String
cleanDesc = rawDescription
For Each punctuationCell In punctuationRng
cleanDesc = Replace(cleanDesc, punctuationCell.Value, "")
Next punctuationCell
CleanDescription = cleanDesc
End Function
If you don't like the For Each you could also achieve it with a For Loop:
Dim cellValue As String
For r = 1 to punctuationRng.Rows.Count
For c = 1 to punctuationRng.Columns.Count
cellValue = punctuationRng.cells(r, c).Value
cleanDesc = Replace(cleanDesc, cellValue, "")
Next c
Next r
You can use a For Each Loop as shown below
Function CleanDescription(rawDescription As String) As String
Dim punctuationRng As Range
Set punctuationRng = Worksheets("ToRemove").Range("A2:A33")
Dim cleanDesc As String
cleanDesc = rawDescription
Dim aCell As Range
For Each aCell In punctuationRng
cleanDesc = Replace(cleanDesc, aCell.Value2, "")
Next aCell
CleanDescription = cleanDesc
End Function
Related
Sorry That I posted my whole code for better visual. I created getcol function to give it the string( column name ) and it returns the range of that column
Public Function getColRange(colName As String) As String
'create variables that will be used in this function
Dim first As String
Dim last As String
Dim col As String
Dim first_row As Integer
Dim first_str As String
Dim last_col As String
Dim last_row As Integer
Dim last_str As String
'loop to check if colname is equal in range between columns A and X, easy to change below
For Each i In Range("A1:X1")
If i = colName Then
'catches column, first and last rows
col = Split(i.Address(1, 0), "$")(0)
last_row = Range("A2").End(xlDown).Row
first_row = 2
'make first and last addresses as strings
first_str = "" & col & first_row
last_str = "" & first_col & last_row
'function ouput in the next line is a combination of above two strings
getColRange = "" & first_str & ":" & col & last_str
End If
Next
End Function
Option Explicit
Sub proper_text()
Dim name_rng As Range
Dim name_cell As Range
Dim name_selection As String
Dim city_rng As Range
Dim city_cell As Range
Dim city_selection As String
Dim col_name As String
Dim trim_name_row As Long
Dim trim_name_rng As Range
Dim trim_name_cell As Range
Dim col_city As String
Dim trim_city_row As Long
Dim trim_city_rng As Range
Dim trim_city_cell As Range
With Credentialing_Work_History
' First Part
name_selection = getColRange("Company_Name")
Set name_rng = Range(name_selection)
For Each name_cell In name_rng
name_cell.Value = WorksheetFunction.Proper(name_cell.Value)
Next
city_selection = getColRange("Company_City")
Set city_rng = Range(city_selection)
For Each city_cell In city_rng
city_cell.Value = WorksheetFunction.Proper(city_cell.Value)
Next
'Second Part
col_name = getColRange("Company_Name")
' To 'Find the last used cell in Col A
trim_name_row = Range(col_name).End(xlDown).Row
'Declare the range used by having the coordinates of rows and column till the last cell used.
Set trim_name_rng = Range(Cells(2, 9), Cells(trim_name_row, 9))
' Loop through the range and remove any trailing space
For Each trim_name_cell In trim_name_rng
trim_name_cell = RTrim(trim_name_cell)
'Go to the next Cell
Next trim_name_cell
col_city = getColRange("Company_Name")
trim_city_row = Range(col_city).End(xlDown).Row
Set trim_city_rng = Range(Cells(2, 10), Cells(trim_city_row, 10))
For Each trim_city_cell In trim_city_rng
trim_city_cell = RTrim(trim_city_cell)
Next trim_city_cell
End With
End Sub
Referring to the Same Worksheet
Always use Option Explicit. If you would have used it, you would have noticed that the variables city_selection and city_cell, and i are not declared.
When having a 'ton' of variables, keep them close to the 'action' to make the code more readable (see in Quick Fix). Use shorter variable names, always preferably (but not necessarily) descriptive.
When using the With statement, you have to use the period (dot, .) in front of Worksheets, Range, Cells, Columns, Rows...etc., e.g.:
With Credentialing_Work_History
Set name_rng = .Range(name_selection)
End With
In this example, you have made sure that the range is in the worksheet Credentialing_Work_History.
You don't have to loop through the cells of the range, you can use Proper and Trim on a range (if you will allow Trim instead of RTrim).
You have to qualify your ranges i.e. make sure they refer to the correct worksheet. See this also in the corrections of the function (added ws parameter).
Note that the function would be more useful if it would return a range instead of a range address so you could use e.g. Set name_rng = getColRange(Credentialing_Work_History, "Company_Name"). That could be one of your next tasks.
The Code
Option Explicit
Sub proper_text()
' Name
Dim name_selection As String
Dim name_rng As Range
name_selection = getColRange(Credentialing_Work_History, "Company_Name")
If name_selection <> "" Then
Set name_rng = Credentialing_Work_History.Range(name_selection)
name_rng.Value = Application.Trim(Application.Proper(name_rng.Value))
End If
' City
Dim city_rng As Range
Dim city_selection As String
city_selection = getColRange(Credentialing_Work_History, "Company_City")
If name_selection <> "" Then
Set city_rng = Credentialing_Work_History.Range(city_selection)
city_rng.Value = Application.Trim(Application.Proper(city_rng.Value))
End If
End Sub
Function getColRange(ws As Worksheet, colName As String) As String
'create variables that will be used in this function
Dim first As String
Dim last As String
Dim col As String
Dim first_col As String
Dim first_row As Long
Dim first_str As String
Dim last_col As String
Dim last_row As Long
Dim last_str As String
Dim rg As Range
'loop to check if colname is equal in range between columns A and X, easy to change below
For Each rg In ws.Range("A1:X1")
If rg = colName Then
'catches column, first and last rows
col = Split(rg.Address(1, 0), "$")(0)
last_row = ws.Range("A2").End(xlDown).Row
first_row = 2
'make first and last addresses as strings
first_str = "" & col & first_row
last_str = "" & first_col & last_row
'function ouput in the next line is a combination of above two strings
getColRange = "" & first_str & ":" & col & last_str
End If
Next rg
End Function
Sub proper_text_QuickFix()
Dim ws As Worksheet: Set ws = Credentialing_Work_History
' Name
Dim name_selection As String
Dim name_rng As Range
Dim name_cell As Range
name_selection = getColRange(ws, "Company_Name")
Set name_rng = ws.Range(name_selection)
Debug.Print name_rng.Address
For Each name_cell In name_rng
name_cell.Value = WorksheetFunction.Proper(name_cell.Value)
Next
' City
Dim city_name_selection As String
Dim city_rng As Range
Dim city_name_cell As Range
city_name_selection = getColRange(ws, "Company_City")
Set city_rng = ws.Range(city_name_selection)
Debug.Print city_rng.Address
For Each city_name_cell In city_rng
city_name_cell.Value = WorksheetFunction.Proper(city_name_cell.Value)
Next
' Trim Name
Dim col_name As String
Dim trim_name_row As Integer
Dim trim_name_rng As Range
Dim trim_name_cell As Range
col_name = getColRange(ws, "Company_Name")
trim_name_row = ws.Range(col_name).End(xlDown).Row
Set trim_name_rng = ws.Range(ws.Cells(2, 9), ws.Cells(trim_name_row, 9))
Debug.Print name_rng.Address
For Each trim_name_cell In trim_name_rng
trim_name_cell = RTrim(trim_name_cell)
Next trim_name_cell
' Trim City
Dim col_city As String
Dim trim_city_row As Integer
Dim trim_city_rng As Range
Dim trim_city_cell As Range
col_city = getColRange(ws, "Company_City")
trim_city_row = ws.Range(col_city).End(xlDown).Row
Set trim_city_rng = ws.Range(ws.Cells(2, 10), ws.Cells(trim_city_row, 10))
Debug.Print trim_city_rng.Address
For Each trim_city_cell In trim_city_rng
trim_city_cell = RTrim(trim_city_cell)
Next trim_city_cell
End Sub
I have a code to highlight words in a cell based on the values in another cells. It works perfectly when I assign FindW = Range("X1") . However the code does not seem to work when I assign range e.g:("X1:X1000") to the string value FindW and I could not find a way to fix this.
Does anyone have any idea?
See the code below:
Dim Rng As Range
Dim FindW As String
Dim xTmp As String
Dim x As Long
Dim m As Long
Dim y As Long
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Übersicht")
Application.ScreenUpdating = False
Application.EnableEvents = False
With ws
FindW = Range("X1:X1000")
y = Len(FindW)
For Each Rng In Range("C:H")
With Rng
m = UBound(Split(Rng.Value, FindW))
If m > 0 Then
xTmp = ""
For x = 0 To m - 1
xTmp = xTmp & Split(Rng.Value, FindW)(x)
.Characters(Start:=Len(xTmp) + 1, Length:=y).Font.ColorIndex = 3
xTmp = xTmp & FindW
Next
End If
End With
Next Rng
End With
End Sub
You can't put the values of a Range of multiple cells directly into a single String variable. However, you can create a String Array and store each cell value individually in the String Array.
The easiest solution is to just use a Variant variable, and put the range values directly in it, like this :
Dim mrange As Range
Dim mVariant As Variant
mVariant = myRange.Value
If you really need your variable to be a String, there are multiples ways to do so:
For example, you can loop through each cell of the Array using something like :
For each mCell in mRange.Cells
mString(i) = mCell.Value
i = i + 1
Next mCell
mRange being your Range, and mString being a String Array. This solution requires for you to know how many cells are in the Range, since the String array needs to be defined with a size.
If you don't know the size of your Range, you can add a step and use a Variant variable.
See here.
I am looking for a way to extract addresses / ranges from a formulae. I have created an example formula below.
=SUMIFS(Worksheet_Name!$C$3:$C$20, Worksheet_Name!$A$3:$A$20, "Blue", Worksheet_Name!$B$3:$B$20, "Green")
I am trying to get some sort VBA routine which I can pick apart the formulae.
I would like to get the ranges as follows:
Worksheet_Name!$C$3:$C$20
Worksheet_Name!$A$3:$A$20
Worksheet_Name!$B$3:$B$20
So I can access these separately.
How about the following, this will take a cell as input, then it will strip out anything outside the brackets and split the remainder of the formula by commas into an array, and then it will display then in a Msgbox, but you can adapt that to your needs:
Sub Get_Ranges_In_Formula()
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
'declare the worksheet you are working with
Dim rngs As String
Dim arrayofRngs
cellvalue = ws.Range("A1").Formula
'get the formula from the cell
openingParen = InStr(cellvalue, "(")
closingParen = InStrRev(cellvalue, ")")
rngs = Mid(cellvalue, openingParen + 1, closingParen - openingParen - 1)
'strip anything outside the brackets
arrayofRngs = Split(rngs, ",")
'split by comma into array
For i = LBound(arrayofRngs) To UBound(arrayofRngs)
If InStr(arrayofRngs(i), "!") > 0 Then MsgBox arrayofRngs(i)
Next
End Sub
A solution using RegEx to extract cell references from formulas:
Sub Get_Ranges_In_Formula()
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim xRetList As Object
Dim xRegEx As Object
Dim I As Long
Dim xRet As String
Dim Rg As Range
Set Rg = ws.Range("A1")
Application.Volatile
Set xRegEx = CreateObject("VBSCRIPT.REGEXP")
With xRegEx
.Pattern = "('?[a-zA-Z0-9\s\[\]\.]{1,99})?'?!?\$?[A-Z]{1,3}\$?[0-9]{1,7}(:\$?[A-Z]{1,3}\$?[0-9]{1,7})?"
.Global = True
.MultiLine = True
.IgnoreCase = False
End With
Set xRetList = xRegEx.Execute(Rg.Formula)
If xRetList.Count > 0 Then
For I = 0 To xRetList.Count - 1
MsgBox xRetList.Item(I)
Next
End If
End Sub
Try this
Sub Test()
Dim e, s As String
s = MyArguments(Range("A1"))
For Each e In Split(s, ",")
If InStr(e, "!") Then Debug.Print Trim(e)
Next e
End Sub
Function MyArguments(rng As Range) As String
MyArguments = Split(Split(rng.Formula, "(")(1), ")")(0)
End Function
I'm having a issue to get a text result which is a concatenate/join of "X" cells of a column based quantity in another cell. Example:
Cell value = 2
Name
Txt1
Txt2
Txt3
Txt4
Result = Txt1Txt2
Cell value = 3
Name
Txt1
Txt2
Txt3
Txt4
Result = Txt1Txt2Txt3
One must have CONCAT():
=CONCAT(A2:INDEX(A2:A5,C1))
If one does not have CONCAT this UDF will mimic the function. Put this in a module attached to the workbook:
Function CONCAT(rng As Range)
Dim rngArr As Variant
rngArr = rng
On Error GoTo onlyone
Dim itm As Variant
For Each itm In rngArr
CONCAT = CONCAT & itm
Next itm
Exit Function
onlyone:
CONCAT = rngArr
End Function
I am trying to convert an array output to string for later manipulation and visibility.
For example I have an array {681120;953160;909420;16300}.
How would I go about converting that into a string?
Try:
Option Explicit
Sub ArrayLoop()
Dim ArrList As Variant
Dim ArrItem As Variant
Dim Result As String
ArrList = Array("681120", "953160", "909420", "16300")
Result = ""
For Each ArrItem In ArrList
If Result = "" Then
Result = ArrItem
Else: Result = Result & "_" & ArrItem
End If
Next
End Sub