Replacing Dot to comma in VBA - excel

I have an issue when I try to replace all "." with ","
It works normal when I use Ctrl + H in the Excel Sheet and do it manually.
I have recorded the Macro from what I do in the sheet, and got this code
Columns("Q:S").Select
Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
But when I run the Macro it only removes the "." , instead of replacing it with "," .
So for instance, if the cell states 4.000 aftter I run the Macro, it returns 4000.
How do I fix this??
I have also tried changing decimal separators in the system, but it does not help me.
Thank you for your help.


This should replace all the periods with commas regardless of data type. (as a string, so you'll no longer be able to easily calculate from them)
You'll still be running into a lot of trouble if you want these numbers to be numbers, with correct separators.
As a side note, When I used find and replace (Ctrl + H) I got the same result where my "4.123" became "4,123.00". This may be related to our system settings.
Sub Test_Replace_Period_with_Comma()
Dim ValueRange As Range
Dim ValueSet
Dim X As Long
Dim Y As Long
Set ValueRange = Intersect(Columns("Q:S"), Sheet8.UsedRange)
ValueSet = ValueRange
If ValueRange.Cells.Count = 1 Then
ReDim ValueSet(1 To 1, 1 To 1)
End If
For X = 1 To UBound(ValueSet, 1)
For Y = 1 To UBound(ValueSet, 2)
'Debug.Print ValueSet(X, Y)
If ValueSet(X, Y) <> "" Then
ValueSet(X, Y) = Replace(CStr(ValueSet(X, Y)), ".", ",", 1, , vbTextCompare)
End If
Next Y
Next X
ValueRange.NumberFormat = "#"
ValueRange = ValueSet
End Sub

Related

Looping Text to Columns Fixed Width on Individual Rows

I am attempting to build a loop that will look at each row in a column of data and split based on the first instance of an " ". I can get this to work on one line but the loop never activates. I tried my best at formatting this code but could not find a tutorial on how to have the commands appear as different colors and whatnot.
Dim num
Dim RowCnt As Integer
Dim x As Integer
ActiveCell.Select ' the cell to split
RowCnt = Range(Selection, Selection.End(xlDown)).Rows.Count 'determines #rows in column to split
With ActiveCell ' with block
For x = 1 To RowCnt ' define # loops
.Offset(, -1).FormulaR1C1 = "=FIND("" "",RC[1],1)" ' determine first " "
num = .Offset(, -1).Value ' assign the number of chars to 'num'
Selection.TextToColumns Destination:=ActiveCell, DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(num, 1)), TrailingMinusNumbers:=True ' splits once based on 'num'
.Offset(, -1).ClearContents ' clear
.Offset(1, 0).Activate
Next x
End With
End Sub

I was able to cheat the answer. The issue is the Text to Columns always referred to the first cell until the sub ended. My solution was to make the looped code its own sub and call it in a separate subs loop. That way it ends the sub each time before being called again.

Use this code instead (tested: works!)
Sub updated_delimitter()
start_cell = ActiveCell.AddressLocal
n = Range(start_cell, Range(start_cell).End(xlDown)).Rows.Count 'determines #rows in column to split
Application.ScreenUpdating = False
For x = 0 To n - 1 ' define # loops
this_cell = Range(start_cell).Offset(x).AddressLocal
Range(this_cell).Select
word_ = Range(this_cell).Value
split_at = InStr(word_, " ")
Range(this_cell).TextToColumns Destination:=Range(this_cell), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(split_at, 1)), TrailingMinusNumbers:=True ' splits once based on 'num'
Next
Application.ScreenUpdating = True
End Sub
original code had issues with referencing in relation to 'activecell' which you referenced in the text-to-columns section - removed the with statement and no need to insert num when you can simply store it within VB (getting rid of its placements also mean no code required to remove it...
You could achieve the same in 3 lines of code♦ (w/ for loop) using the following:
Sub test2()
'Range("d2").Select
With Selection
.Offset(, 3).Formula2R1C1 = _
"=LET(x_,RC[-3]:OFFSET(RC[-3],MATCH(0,IFERROR(SEARCH("""",RC[-3]:OFFSET(RC[-3],ROWS(C[-3])-ROWS(RC[-3])-1,0)),0),0)-1,0),IF(ISODD(SEQUENCE(1,2,1,1)),MID(x_,1,IFERROR(SEARCH("" "",x_)-1,LEN(x_))),IF(ISERROR(SEARCH("" "",x_)),"""",MID(x_,SEARCH("" "",x_)+2,LEN(x_)))))"
Range(.AddressLocal, .End(xlDown).Offset(, 1)).Value = Range(Replace(.Offset(, 3).AddressLocal, "$", "") & "#").Value
.Offset(, 3).ClearContents
End With
End Sub
This uses the function:
=LET(x_,D2:OFFSET(D2,MATCH(0,IFERROR(SEARCH("",D2:OFFSET(D2,ROWS(D:D)-ROWS(D2)-1,0)),0),0)-1,0),IF(ISODD(SEQUENCE(1,2,1,1)),MID(x_,1,IFERROR(SEARCH(" ",x_)-1,LEN(x_))),IF(ISERROR(SEARCH(" ",x_)),"",MID(x_,SEARCH(" ",x_)+2,LEN(x_)))))
... which is an array function that reproduces the original list with relevant cells split as req.
REVISED
Here for sample file (requires Microsoft Onedrive a/c - read only file avail.)
♦ Office 365 compatibility; '3 lines' ignoring with/end/sub/etc.
ta 💪

Deleting a sentence that starts with a specific string but ends differently

My VBA is kind of rusty. I have the following problem: I have a column that contains labels for a questionnaire, and there is a lot of extra words tacked on to each label making them almost unreadable. The sentences I need to get rid of are very similar but come with different punctuation and can either appear in the beginning of the cell of in the middle. All sentences start with the word "Using". Here are some examples of cells that I need to clean up (3 main types):
1) "ABC123: - Using a scale of 1 to 5 ... . SomeText1" (sentence to remove starts with "Using" and ends with ".")
2) "DEF456: - Using a 1 to 5 point scale ... : SomeText2" (sentence to remove starts with "Using" and ends with ":")
3) "SomeTextLongerThan20Characters - Using a 1-5 point sca" (sentence to remove starts in the middle of the cell and is cut off in the middle)
I need these 3 cases to look like this:
1) "ABC123: SomeText1"
2) "DEF456: SomeText2"
3) "SomeTextLongerThan20Characters"
Here is my code that I could not get to work:
Sub Edit_String()
'
' Edit_String Macro
' Replaces chosen string with another string or nothing
'
Dim MyRange, c As Range
Dim strA, strB As String
For Each c In MyRange
Select Case Left(c.Text, 20)
Case Left(c.Text, 20) Like "*- Using*"
strA = "- Using*."
Case Left(c.Text, 20) Like "*: Using*"
strA = "- Using*:"
' Case Else
' If Left(c.Text, 20) <> "*Using*" Then strA = "- Using*"
End Select
Selection.Replace What:=strA, Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Next c
MsgBox ("macro finished running")
End Sub
The last Case Else is commented out since I figured I don't need it.
I'd appreciate any help. This seems like a simple wildcard/find/replace issue, but I can't figure it out.

If your original code works for you besides the case statement. This will get the case statement working.
Sub Edit_String()
'
' Edit_String Macro
' Replaces chosen string with another string or nothing
'
Dim MyRange, c As Range
Dim strA, strB As String
[A1] = "ABC123: - Using a scale of 1 to 5. ... . SomeText1"
[A2] = "DEF456: - Using a 1 to 5 point scale ... : SomeText2"
[A3] = "SomeTextLongerThan20Characters - Using a 1-5 point sca"
Set MyRange = [a1:a3]
For Each c In MyRange
c.Select
Select Case True
Case Left(c.Text, 20) Like "*- Using*"
strA = "- Using*."
Case Left(c.Text, 20) Like "*: Using*"
strA = "- Using*:"
' Case Else
' If Left(c.Text, 20) <> "*Using*" Then strA = "- Using*"
End Select
Selection.Replace What:=strA, Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Next c

You should be able to put the following in a blank workbook to test.
Sub GetSentence()
Dim MyRange, c As Range
Dim strA, strB As String
Dim SplitItUp As Variant
Dim LeftPart, RightPart As String
[A1] = "ABC123: - Using a scale of 1 to 5. ... . SomeText1"
[A2] = "DEF456: - Using a 1 to 5 point scale ... : SomeText2"
[A3] = "SomeTextLongerThan20Characters - Using a 1-5 point sca"
Set MyRange = [a1:a3]
UsingLit = " - Using"
For Each c In MyRange
SplitItUp = Split(c.Value, UsingLit)
If UBound(SplitItUp) = 0 Then
Debug.Print UsingLit + " Not Found"
Else
LeftPart = Trim(SplitItUp(0))
RightPart = Trim(SplitItUp(UBound(SplitItUp)))
If InStr(RightPart, ":") Then
SplitItUp = Split(c.Value, ":")
RightPart = SplitItUp(UBound(SplitItUp))
Else
SplitItUp = Split(c.Value, ".")
If UBound(SplitItUp) > 0 Then
RightPart = SplitItUp(UBound(SplitItUp))
Else
RightPart = ""
End If
End If
End If
Debug.Print LeftPart + " " + RightPart
Next c
End Sub

I was googling for this but if there was a way to use excels find and replace to do this. I figured it out myself and I want to put the answer here if anyone else was in the same boat as me. The trick is to type in the search the start of the word with a asterix, add one space, put another asterix and what it should end with.

Replacing a string of text when only knowing a certain amount of characters

I have a list of PO numbers. They look something like (4010059877-TUR36036133 or TUR6039716## 4010073239). I need to be able to narrow the cell down to only the PO number which is the 4010059877 number. The only consistent part about the part I want to exclude is the "TUR########".
I have worked on code that excludes all non-numeric characters, but some of the cells have these "TUR #'s". I worked on a find and replace with a wildcard "*". I have also searched the web and didn't see anything similar.
Find and Replace attempted code
Sub Replace()
Columns("AJ").Replace What:="TUR*", _
Replacement:="", _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False
End Sub
Replacing all non-numeric characters which leaves behind unwanted numbers behind the TUR########
Dim finRow As String
finRow = Sheets("Data").Range("A20000").End(xlUp).Row
Set myRange = Sheets("Data").Range("AK2:AK" & finRow)
For Each myCell In myRange
LastString = ""
For I = 1 To Len(myCell.Value)
mT = Mid(myCell.Value, I, 1)
If mT Like "[0-9]" Then
tString = mT
Else
tString = ""
End If
LastString = LastString & tString
Next I
myCell.Value = LastString
Next
My expected result would be for the TUR######## to be eliminated and replaced with nothing.

You can use InStr() function and then use that to support Left, such that:
loc = instr(mycell,"TUR")
val = left(mycell.value,loc-1)
Edit1:
Due to SJR's comment, will add an example of handling the issue when "TUR" is found in position 1:
loc = instr(mycell,"TUR")
if loc = 1 then
val = ""
else
val = left(mycell.value,loc-1)
end if
Edit2:
Dim val as long 'assumes you will only have a number in the end
val = right(left(mycell.value,12),11)
mycell.value = val
This should cut the first parenthesis off and have no issues with the info after the 11 digit PO. This could even be specific to the case (a switch) where instr(mycell.value,"TUR") is true, in case you have other possible scenarios.

We can also try doing a regex replacement:
Dim Regex As System.Text.RegularExpressions.Regex
Dim input As String = "4010059877-TUR36036133"
Dim output As String = Regex.Replace(input, "([0-9]+)-TUR[0-9]+", "$1")
Console.WriteLine(output)
This outputs: 4010059877

Excel VBA Extract Specific Data from Column of Mixed Data

I have a list of Tyres form the internet, the list is 5,000 lines long in one column.
I need to extract from each line the data in BOLD ideally into the next column
EXAMPLE of TYRES
LS388 (145/70 R13 71T)
LS388 (155/65 R13 73T)
LS388 (155/65 R14 75T)
4-Seasons (155/65 R14 75T)
CT6 (155/70 R12 104N) 72EE
LS388 (155/70 R13 75T)
The problem is that the number can be between 59 and 120 and the letter could be H T V R N X Z and so on. Also the text could be anywhere within the line of data not always towards the end as shown.
There could be 100 variations to look for and
Rather than having one line of code to search for a LIKE 71T for each line of tyres, can I use a source table of these variations and reference them one by one in the code is some sort of loop? or other suggestions if in VBA appreciated
At the moment I have this VBA code for each possible variation, one line for each variant.
ElseIf ActiveCell.Value Like "*79S*" Then
ActiveCell.offset(0,1).Value = "79S"

Insert this formula in a cell it is assuming your string is present in column A, you can change it if it is not the case and check how many it extracts.
=MID(A1,SEARCH(" ",A1,SEARCH("R1?",A1))+1,SEARCH(")",A1)-SEARCH(" ",A1,SEARCH("R1?",A1))-1)
filter out the remaining ones, find some thing common in them and let me know and we can build another formula for those cells.

I recommend to use Regular Expressions for that if you need to do it with VBA. There is a pretty good explanation at
How to use Regular Expressions (Regex) in Microsoft Excel both in-cell and loops.
As pattern you could use something like .+\(.+ (.+)\).* (see https://regex101.com/r/jK1zKc/1/)
For a manual solution
Use Split text into different columns with the Convert Text to Columns Wizard to split into columns by the spaces.
Then do a simple replace ")" by "" in column D.
Or do the manual solution with VBA (assuming your data in column A):
Option Explicit
Sub SplitAndDelet()
Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=True, OtherChar:= _
")", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)) _
, TrailingMinusNumbers:=True
Range("A:C,E:E").Delete Shift:=xlToLeft
End Sub

If you want to do this in vba you could set up an array of tyres and loop through them for each cell. for example if you had this on your sheet;
you could do something like this;
Public Sub FindTyres()
' Column to Loop
Dim col As String
col = "B"
' rows to Loop
Dim startRow As String
Dim endRow As String
startRow = "2"
endRow = "7"
' Get list of Tyres
Dim tyresArr()
tyresArr = getTyresArr()
' Set Range to Loop
Dim rng As Range, cell As Range
Set rng = Range(col & startRow & ":" & col & endRow)
' Looping through Array params
Dim tyre As Variant
' Loop through Cells
For Each cell In rng
currentCellVal = cell.Value
' Loop through tyres
For Each tyre In tyresArr
Debug.Print tyre
' if you find it do something
If InStr(1, currentCellVal, CStr(tyre)) <> 0 Then
MsgBox "Value " & CStr(tyre) & " Contained in Cell " & cell.Address
Exit For
End If
Next tyre
Next cell
End Sub
Private Function getTyresArr()
Dim tyresArr(3)
tyresArr(0) = "71T"
tyresArr(1) = "73T"
tyresArr(2) = "75T"
tyresArr(3) = "104N"
getTyresArr = tyresArr
End Function
Please note this assumes you will only ever have one tyre code per line.
you may get some false positives if these strings exist for other reasons.
you would need to enter all the codes into the function that returns the array.

Macro for Text to columns

Sub Macro9()
'
' Macro9 Macro
'
'
Selection.TextToColumns Destination := Range("A3"), DataType := xlFixedWidth, _
FieldInfo := Array(Array(0,1),Array(60,1),Array(63,1),Array(68,1),Array(71,1), _
Array(85,1),Array(88,1),Array(93,1),Array(99,1),Array(107,1),Array(111,1),Array _
(120,1),Array(123,1),Array(127,1),Array(130,1),Array(134,1),Array(143,1),Array( _
147,1),Array(157,1),Array(162,1),Array(165,1),Array(170,1),Array(202,1),Array( _
233,1),Array(236,1),Array(238,1),Array(248,1),Array(251,1),Array(260,1),Array( _
265,1),Array(277,1),Array(283,1),Array(287,1),Array(291,1),Array(295,1),Array( _
299,1),Array(302,1),Array(306,1),Array(310,1),Array(322,1),Array(326,1),Array( _
332,1),Array(335,1),Array(338,1),Array(344,1),Array(348,1),Array(356,1),Array( _
360,1),Array(367,1),Array(373,1),Array(375,1),Array(384,1),Array(387,1),Array( _
394,1),Array(398,1),Array(403,1),Array(409,1),Array(413,1),Array(419,1),Array( _
424,1),Array(429,1),Array(432,1),Array(438,1),Array(444,1),Array(449,1),Array( _
454,1),Array(458,1),Array(463,1),Array(468,1),Array(474,1),Array(478,1),Array( _
481,1),Array(484,1),Array(489,1),Array(493,1),Array(524,1),Array(554,1),Array( _
557,1),Array(563,1),Array(565,1),Array(577,1),Array(594,1),Array(613,1),Array( _
616,1),Array(620,1),Array(626,1),Array(629,1),Array(634,1),Array(646,1),Array( _
654,1),Array(659,1),Array(667,1),Array(669,1),Array(675,1),Array(683,1),Array( _
689,1),Array(696,1),Array(699,1),Array(706,1),Array(714,1),Array(717,1),Array( _
721,1),Array(728,1),Array(730,1),Array(743,1),Array(751,1),Array(754,1),Array( _
758,1),Array(767,1),Array(774,1),Array(779,1),Array(787,1),Array(790,1),Array( _
798,1),Array(805,1),Array(808,1),Array(817,1),Array(822,1),Array(826,1),Array( _
835,1),Array(845,1),Array(853,1),Array(857,1),Array(864,1),Array(869,1),Array( _
877,1),Array(881,1),Array(891,1),Array(895,1),Array(903,1),Array(912,1),Array( _
916,1),Array(920,1),Array(927,1),Array(933,1),Array(937,1),Array(941,1),Array( _
End Sub
I have 800 words in cell A3 in sheet input1, i recorded above macro by using function "Text to columns" in Excel 2007 which is giving error "Too many line continuations".
Can someone tell me the exact code please, indeed I want to add all the 800 words in different individual cells as one word in each cell in the same row.

I do not believe it is possible to tell the Macro Recorder to create longer lines so I do not think TextToColumns can be made to record this code for you.
You are using the fixed width option so words are starting at position 0, 60, 63, 68, 71 and so on. The start positions for about 120 words have been have been recorded so, if you wanted to build an array like this, you will have a lot of typing.
You say "words". To me that implies variable length strings separated by spaces. If that is correct, try the code below. It uses function Split to split cell A3 into words by space. These are then spread out along row 4 with any gaps created by double or triple spaces ignored.
Option Explicit
Sub SplitCell()
Dim CellCrnt As Long
Dim InxW As Long
Dim Word() As String
With Worksheets("input1")
Word = Split(.Range("A3"), " ")
CellCrnt = 1
For InxW = LBound(Word) To UBound(Word)
' Any double spaces will cause empty entries in Word.
' Ignore these empty entries
If Word(InxW) <> "" Then
.Cells(4, CellCrnt).Value = Word(InxW)
CellCrnt = CellCrnt + 1
End If
Next
End With
End Sub

Resources