Remove or add text after a specific character in Excel - vba

I have lot of data in my excel sheet , i want to remove all text after Last (-) character .
Here is sample data like in my sheet
"This-is-car-44"
"This-is-my-school-ok"
I want look like this
"This-is-car"
"This-is-my-school"
i want to remove all text after lats - , so is their any formula to do this.
and one thing more if possible can i do like this in excel
"This-is-car-44"
"This-is-my-school-ok"
to look like this
"This-is-car/"
"This-is-my-school/"
i mean after last - remove all text and add this / in end .
thanks.

If you are OK with excel formulas, please try this,
=SUBSTITUTE(A1,"-"&TRIM(RIGHT(SUBSTITUTE(A1,"-",REPT(" ",LEN(A1))),LEN(A1))),"/")

You can do something like this.
Sub RemoveLastStingPart()
Dim rng As Range
Dim intLastRow As Long
Dim strTemp As String
Dim aryTemp() As String
With ActiveSheet
intLastRow = .UsedRange.Rows.Count
Set rng = .Range(Cells(1, 1), Cells(intLastRow, 1))
For Each cell In rng
strTemp = cell.Value
aryTemp = Split(strTemp, "-")
strTemp = ""
For i = 0 To UBound(aryTemp) - 1
strTemp = strTemp & aryTemp(i) & "-"
Next i
strTemp = Left(strTemp, Len(strTemp) - 1)
cell.Offset(0, 1).Value = strTemp
Next cell
End With
End Sub

Related

VBA - check if a string is is 1 of those in a column of a different sheet, in an if statement

Hello i want to simpify the formula from
If InStr(1, Sheets("Le 2250").Cells(i, 1).Value, "250-") Or _
If InStr(1, Sheets("Le 2250").Cells(i, 1).Value, "135-") Or _
If InStr(1, Sheets("Le 2250").Cells(i, 1).Value, "700-")
to have the "250-" be 1 of the values in a column of a specific sheet, rather than having to put many "Or if ()" functions with the numerous strings i have to lpok for
Any help appreciated.
Here is an alternative that uses the Evaluate method...
If Evaluate("OR(ISNUMBER(MATCH({""*250-*"",""*135-*"",""*700-*""},{""" & Sheets("Le 2250").Cells(i, 1).Value & """},0)))") Then
Note, however, the number of characters used with the Evaluate method cannot exceed 255, otherwise an error will be returned.
Basically, build an array of your test values, and loop that array until you find something.
Something like this
Sub Demo()
Dim ws As Worksheet
Dim rTestStings As Range, TestStings As Variant
Dim TestValue As Variant
Dim idx As Long
Dim Found As Boolean
'Get Test Strings from Sheet. Adjust to suit your data
With rTestStings = Worksheets("specific sheet")
Set rTestStings = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With
TestStings = rTestStings.Value2
Set ws = Sheets("Le 2250")
'I'm guessing you are doing something like this
For i = SomeValue To SomeOtherValue
TestValue = ws.Cells(i, 1).Value
Found = False
For idx = LBound(TestStings, 1) To UBound(TestStings, 1)
If Not IsEmpty(TestStings(idx, 1)) Then 'incase there are gaps in your test data
If InStr(TestValue, TestStings(idx, 1)) Then
Found = True
Exit For
End If
End If
Next
If Found Then
MsgBox "Found " & TestStings(idx, 1) & " in cell " & ws.Cells(i, 1).Address
' do something ...
End If
Next i
End Sub

Merging a range of excel cells in a column into one single cell seperated by new lines

I need help with excel.
I have a column with hundreds of cells that I need to combine into one cell.
The values in the cells are already centered. Also, some cells have multiple values that are stacked on top of each other using (ALT + ENTER).
I need to choose a range of these cells and combine them and stack them on top of each other into one cell.
If I can also get rid of extra "new lines" between the values as well as repeated values that would be an added bonus.
Here is a picture of what it looks like and what I'm aiming at. I've been trying to learn vbscript and macros, but this is on a bit of a deadline. I appreciate the help.
The following shows you how to combine all numbers from a column into a single cell in VBA Excel, which is what I assume the coding language you are using.
There are two Procedures I use: 1) a columnCombine() Sub and 2) a Custom Split() Function courtesy of Wade Tai of Microsoft
Link to Wade's Article with Split Function: http://msdn.microsoft.com/en-us/library/aa155763%28office.10%29.aspx
columnCombine() Sub:
Sub columnCombine()
'variables needed:
Dim col As Integer
Dim startRow As Integer
Dim endRow As Integer
Dim firstCell As Range
Dim lastCell As Range
Dim i As Integer
Dim s As Variant
Dim destinationCell As Range
Dim strg As Variant
Dim strgTemp() As String
'enter first and last cells of column of interest in the "A1/A2/A3..." format below:'
Set firstCell = Range("A1") 'this can be what you want
Set lastCell = Range("A3") 'this can be what you want
'enter destination cell in same format as above
Set destinationCell = Range("B1") 'this can be what you want
'get column of interest
col = firstCell.Column
'get start row and end row
startRow = firstCell.Row
endRow = lastCell.Row
'set temp string
strg = ""
For i = startRow To endRow
strgTemp = Split(Worksheets("Sheet1").Cells(i, col).Value)
For Each s In strgTemp
If strg = "" Then
strg = s
Else
strg = strg & vbNewLine & s
End If
Next s
Erase strgTemp
Next i
'add column to string
destinationCell.Value = strg
End Sub
Split() Function:
Public Function Split(ByVal InputText As String, _
Optional ByVal Delimiter As String) As Variant
' This function splits the sentence in InputText into
' words and returns a string array of the words. Each
' element of the array contains one word.
' This constant contains punctuation and characters
' that should be filtered from the input string.
Const CHARS = "!?,;:""'()[]{}"
Dim strReplacedText As String
Dim intIndex As Integer
' Replace tab characters with space characters.
strReplacedText = Trim(Replace(InputText, _
vbTab, " "))
' Filter all specified characters from the string.
For intIndex = 1 To Len(CHARS)
strReplacedText = Trim(Replace(strReplacedText, _
Mid(CHARS, intIndex, 1), " "))
Next intIndex
' Loop until all consecutive space characters are
' replaced by a single space character.
Do While InStr(strReplacedText, " ")
strReplacedText = Replace(strReplacedText, _
" ", " ")
Loop
' Split the sentence into an array of words and return
' the array. If a delimiter is specified, use it.
'MsgBox "String:" & strReplacedText
If Len(Delimiter) = 0 Then
Split = VBA.Split(strReplacedText)
Else
Split = VBA.Split(strReplacedText, Delimiter)
End If
End Function
*UPDATE:
If you desire to use this on multiple different columns with the intention of moving everything to one cell, use this code recursively or in some repetitive manner e.g. write a script that uses columnCombine to combine the column sections you are referencing into different cells in one column. Then run the program again (or as many times as you need) so that you get the data into one cell.
If you want to change the order in which you iterate through a column e.g. you want to iterate from A4 to A1 instead of A1 to A4, just change For i = startRow To endRow to For i = endRow To startRow.
Note this will not change the order of organization of data within an individual cell, only a whole column. In other words, {["hello","Hello"],["One"],["Two", "Three"]} would become {["Two","Three"],["One"],["hello","Hello"]}
To change the order within a cell, you would need to either alter the For Each statement in columnCombine() or
manually change the order of strg. Both of which are not to hard to do.
Here is a solution I would do:
Add this in addition to the current variables :
Dim strg2 As Variant
strg2 = ""
Change this code:
For i = startRow To endRow
strgTemp = Split(Worksheets("Sheet1").Cells(i, col).Value)
For Each s In strgTemp
If strg = "" Then
strg = s
Else
strg = strg & vbNewLine & s
End If
Next s
Erase strgTemp
Next i
'add column to string
destinationCell.Value = strg
To:
For i = endRow To startRow
strgTemp = Split(Worksheets("Sheet1").Cells(i, col).Value)
For Each s In strgTemp
If strg = "" Then
strg = s
Else
strg = s & vbNewLine & strg
End If
Next s
If strg2 = "" Then
strg2 = strg
Else
strg2 = strg2 & vbNewLine & strg
End If
strg = ""
Erase strgTemp
Next i
'add column to string
destinationCell.Value = strg2
Remember, this change is specific to iterating through items backward and reordering them backwards. The columnCombine() sub will very depending on how you want the data presented

Concatenating and iterating through multiple Cells VBA excel

I want to iterate through data (simular to that shown below) that is stored in different cells and combine them into a single cell seperated by a new line (chr(10)). The amount of data that needs to be imported into one cell will change.
2991
19391
423
435
436
The code needs to iterate through the whole sheet regardless of any line breaks. The required format is:
2991 - all three cells would be combined into one cell in the next column to this one.
19391
423
-Line space, this will need to be taken into account and is the seperator of data.
26991 - all four cells would be combined into one cell in the next column to this one.
19331
424
6764
Below is what I have got so far, it takes the column to the left of the current row and combines it, which is wrong.
Sub ConcatColumns()
Do While ActiveCell <> "" 'Loops until the active cell is blank.
ActiveCell.Offset(0, 1).FormulaR1C1 = _
ActiveCell.Offset(0, -1) & chr(10) & ActiveCell.Offset(0, 0)
ActiveCell.Offset(1, 0).Select
Loop
End Sub
You can achieve the above with this code
Sub Main()
Dim i As Long
Dim c As Range
For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
Dim strBuilder As String
Set c = Range("A" & i)
If Not IsEmpty(c) And i <> 1 Then
strBuilder = c & Chr(10) & strBuilder
ElseIf i = 1 Then
strBuilder = c & Chr(10) & strBuilder
c.Offset(0, 1) = Left(strBuilder, Len(strBuilder) - 1)
strBuilder = vbNullString
Else
c.Offset(1, 1) = Left(strBuilder, Len(strBuilder) - 1)
strBuilder = vbNullString
End If
Next i
End Sub
I think this could be done using a UDF.
Something like
Public Function JoinValues(rng As Range) As String
Dim cell As Range
Dim str As String
For Each cell In rng
If cell.Value <> "" Then
str = str & cell.Value & Chr(10)
End If
Next cell
If Len(str) > 1 Then JoinValues = Left(str, Len(str) - 1)
End Function
Then usage would be =JoinValues(A1:A10) in a cell to join values. You would also have to change cell formatting in the target cell to allow wrapping text for this to work properly.
Assuming your values start in cell A2 enter
=IF(A1="",joinvalues(OFFSET(A2,0,0,MATCH(TRUE,INDEX(ISBLANK(A2:A10000),0,0),0)-1)),"")
in B2 and drag the function down.

Excel - Find & Replace Part of String But in Same Cell?

I have
Column A
Red-US
Blue-INT
Purple-INT
White-US-CA
Trying remove -us, int, ca, etc.
So it's just Red, Blue, Purple, etc.
Can't use Trim or Substitute formula because I want it to change directly in Column A (replace)
Thank you!
If the "-" is a consistent separator then it should be pretty simple.
Here are some commands you could use:
Strings and Manipulations
Edit: Added simple code
Sub textuptodash()
i = 1 'start on row 1
Do While Not IsEmpty(Cells(i, 1)) 'do until cell is empty
If Not InStr(1, Cells(i, 1), "-") = 0 Then 'if dash in cell
Cells(i, 1) = Left(Cells(i, 1), InStr(1, Cells(i, 1), "-") - 1) 'change cell contents
End If
i = i + 1 'increment row
Loop
End Sub
Try using Split as follows:
Sub MySplit()
Dim rngMyRange As Range, rngCell As Range
Dim strTemp() As String, strDel As String, strTest As String
Dim lngCnt As Long
Set rngMyRange = Range("A1:A4")
For Each rngCell In rngMyRange
' Split the test based on the delimiter
' Store entries in a vector of strings
strTemp = Split(rngCell.Text, "-")
' Reset cell value and intermmediate delimiter
rngCell.Value = vbNullString
strDel = vbNullString
' Scan all entries. store all of them but not the last -* part
For lngCnt = LBound(strTemp) To UBound(strTemp) - 1
rngCell = rngCell & strDel & strTemp(lngCnt)
' If we enter the loop again we will need to apend a "-"
strDel = "-"
Next lngCnt
Next rngCell
End Sub
Output:
Red
Blue
Purple
White-US
It is not entirely clear how you want the last entry to be split: assumed that you want to remove the last "-*" bit only. To keep the first part only, comment out the For lngCnt loop.
I hope this helps!

How to compare string from cell with string from inputBox()

I have a spread sheet that look like so:
Group | Name | Title
-----------------------------------
X WS -
X DH -
X M -
X DH -
X WS -
I want to loop through all the cells in name and replace the initial there with their full name in addition to adding the correct title. My script is failing to accurately compare the strings and go into the if-statement:
Sub enterNameAndTitle()
lastCell = InputBox("Last cell")
rInitials = InputBox("Initials")
rFullName = InputBox("Full Name")
rTitle = InputBox("Title")
Dim cell As Range
For Each cell In Range("b2:b" & lastCell).Cells
MsgBox (cell.Text & " : " & rInitials)
If StrComp(UCase(cell.Value), UCase(rInitials)) = 0 Then
cell.Value = rFullName
ActiveSheet.Cells(cell.Row, cell.Column + 1).Value = rTitle
End If
Next cell
End Sub
So I first collect the data and then loop through all the values. Does anyone know what I am doing incorrectly? Why doesn't it compare the string accurately?
I don't see anything wrong, but there are 2 things I would try
One is to use TRIM to make sure neither string has leading or trailing blanks
The 2nd is to change the if to if(ucase(trim(cell.value))=ucase(trim(rInitials)))
The problem was one of differing types and the only way that seemed to work for me was to re-cast both variables as type String using CStr()
Sub enterNameAndTitle()
Dim lastCell As String
lastCell = InputBox("Last cell")
'Cast to string
Dim rInitials As String
rInitials = CStr(InputBox("Initials"))
Dim rFullName As String
rFullName = InputBox("Full Name")
Dim rTitle As String
rTitle = InputBox("Title")
Dim cell As Range
For Each cell In Range("b2:b" & lastCell).Cells
Dim cellText As String
'Cast to string
cellText = CStr(cell.Text)
If (Trim(UCase(cell.Value)) = Trim(UCase(rInitials))) Then
MsgBox ("test1")
cell.Value = rFullName
ActiveSheet.Cells(cell.Row, cell.Column + 1).Value = rTitle
End If
Next cell
End Sub