I would like to insert a space between numbers and letters in a column.
Example of the text in the column.
925 LANE AVE SOUTH apt106H
85SW162ND
P O BOX101586
11939 magnolia falls DRIVE
1029BAILLIES ROAD
6870 SR207
14701 nw 77 TH AVENUE
14701NW77THAVENUE
1325NW93CTB103
Po Box272771
2137FERNWOODlane
5702 highway 17/92 CASSELBERRY FL
2254 NW 82 NS AVE
9110SW13TH aveAPT #203
I was thinking of a flag which will toggle if it finds a non-numeric character and will also add a space in the process. This should also work when it finds a numeric character.
Function AddSpace(Str As String) As String
Dim StringLength As Integer
Dim Flag As Integer ' Flag 0 means char, 1 means numeric
StringLength = Len(CellRef)
For i = 1 To StringLength
If IsNumeric(Mid(CellRef, i, 1))
Then Flag = 1
Result = Result & Mid(CellRef, i, 1)
else Flag = 0
endif
Result = Result & Mid(CellRef, i, 1)
Next i
AddSpace = Result
End Function
How about:
Public Function spacer(s As String) As String
Dim i As Long, buf As String, L As Long
L = Len(s)
If L < 2 Then
spacer = s
Exit Function
End If
buf = Left(s, 1)
For i = 2 To L
v1 = Right(buf, 1)
v2 = Mid(s, i, 1)
If (v1 Like "[a-zA-Z]" And v2 Like "[0-9]") Or (v2 Like "[a-zA-Z]" And v1 Like "[0-9]") Then
buf = buf & " "
End If
buf = buf & v2
Next i
spacer = buf
End Function
Related
I have some code as shown below that i found on a forum , that will convert ASCII Code to Hexadecimal Characters using a VBA script, is it possible to convert Hex Characters to ASCII Characters ??
The code i have is as follows
Sub AsciiToHex()
Dim strg As String
Dim tmp As String
strg = Worksheets("Sheet1").Range("A1")
Worksheets("Sheet1").Range("A5").value = strg
tmp = ""
For i = 1 To Len(strg)
tmp = tmp & hex((Asc(Mid(strg, i, 1))))
Next
Worksheets("Sheet1").Range("A6").value = tmp
End Sub
I have tried to to swap the hex((Asc(Mid(strg, i, 1)))) to Asc((hex(Mid(strg, i, 1)))) but that did not work. Any help would be appreciated
Sample Data
Hex Format
48 65 6C 6C 6F
After conversion would be the following
Ascii Format
H e l l o
Hex To String
Function HexToString(InitialString As String) As String
Dim i As Long
For i = 1 To Len(InitialString) Step 2
HexToString = HexToString & Chr("&H" & (Mid(InitialString, i, 2)))
Next i
End Function
Function StringToHex(InitialString As String) As String
Dim i As Long
For i = 1 To Len(InitialString)
StringToHex = StringToHex & Hex(Asc(Mid(InitialString, i, 1)))
Next i
End Function
How about:
Public Function KonvertHex(s As String) As String
KonvertHex = ""
For i = 1 To Len(s)
KonvertHex = KonvertHex & Asc(Mid(s, i, 1))
Next i
End Function
This uses the worksheet function Hex2Dec.
[a1:e1] = [{"48", "65", "6C", "6C", "6F"}]
For Each c In Range("a1:e1")
c.Offset(1, 0) = Chr(WorksheetFunction.Hex2Dec(c))
Next c
https://learn.microsoft.com/en-us/office/vba/api/excel.worksheetfunction.hex2dec
I've the following Excel data:
A B C
+ ------------ ------------- -----------------
1 | WORD WORD MIX MATCH TEXT RESULT
2 | somewordsome emsomordsowe ...
3 | anotherword somethingelse ...
4 | ... ... ...
I'd like to:
Firstly, get an array, say ArrayOfGroups, by splitting the string in the A2 cell in unique groups of 2 to 12 adjacent chars (note: 2 is the minimum number of chars to form a group; 12 is the total number of the word's chars) i.e. the groups of 2 chars would be so, om, me, ew, wo, or, rd, ds (note: the last so, om and me groups are excluded because they are repeated); the groups of 3 chars would be som, ome, mew, ewo, wor, ord, rds, dso (last som and ome excluded); the groups of 4 chars would be some, omew, mewo, ewor, word, ords, rdso, dsom; ... and so on until the full string somewordsome.
Then, iterate the above-mentioned ArrayOfGroups to check if each of its element is a substring of the B2 cell and return a new array, say ArrayOfMatches, containing all the elements (the characters "group names") that are substrings of B2 and the number of occurrences found in B2.
Finally, output in the C2 cell a sentence built using the ArrayOfMatches data that says something like this:
2 matches for so, 1 match for som and rd
Probably there are other and better approaches to compute the above sentence that is the final result wanted. Maybe I need to use a User Defined Function... but I never made it.
Is there someone that could give help?
May try something like this
Code edited to avoid counting for same substring found multiple times.
Sub test2()
Dim Xstr As String, Ystr As String
Xstr = "somewordsome"
Ystr = "emsomordsowe"
MsgBox Xmatch2(Xstr, Ystr)
End Sub
Function Xmatch2(Xstr As String, Ystr As String) As String
Dim XSubStr As String, YSubStr As String
Dim xLn As Integer, yLn As Integer
Dim XArr As Variant, LnSubStr As Integer
Dim Rslt As String, Cnt As Integer
Dim Xrr() As Variant, Xcnt As Integer, Chk As Boolean
Rslt = "'"
xLn = Len(Xstr)
yLn = Len(Ystr)
For LnSubStr = 2 To xLn 'length of substring
Xcnt = 0
ReDim XArr(1 To 1)
For Y = 1 To xLn
XSubStr = ""
Xcnt = Xcnt + 1
ReDim Preserve XArr(1 To Xcnt)
If Y + LnSubStr - 1 <= xLn Then XSubStr = Mid(Xstr, Y, LnSubStr)
XArr(Xcnt) = XSubStr
Chk = False
For i = 1 To Xcnt - 1
If XArr(i) = XSubStr Then
Chk = True
Exit For
End If
Next
If XSubStr <> "" And Chk = False Then
Cnt = 0
ReDim Preserve XArr(1 To Xcnt)
For Z = 1 To yLn
YSubStr = ""
If Z + LnSubStr - 1 <= yLn Then YSubStr = Mid(Ystr, Z, LnSubStr)
If YSubStr = XSubStr Then Cnt = Cnt + 1
Next
If Cnt > 0 Then Rslt = Rslt & Cnt & " Matches for " & XSubStr & ","
End If
Next
Next
Debug.Print Rslt
Xmatch2 = Rslt
End Function
I am working on some software that cleans up data before sending it into another system. The data comes from all around the world and contains a variety of characters that have to be replaced. For example ‘, : ; #
The system that accepts the parsed data has very strict character set. It allows
the letters A to Z (upper case only)
the numerals 0 to 9
the special characters / -. Space < =
The data arrives in Excel spreadsheets so I have written the following code in a visual basic macro.
fhl_str contains the data to be cleansed
fhl_str = Replace(fhl_str, ",", " ")
fhl_str = Replace(fhl_str, "'", " ")
fhl_str = Replace(fhl_str, ":", " ")
fhl_str = Replace(fhl_str, ";", " ")
fhl_str = ucase(fhl_str)
Now, each time a new unwanted character arrives we have to add a new line of code. e.g. fhl_str = Replace(fhl_str, "#", " ")
My question is
Could I reverse the logic so that the macro looks for A to Z and 0 to 9 and deletes anything else. That way my code would be future proof for new unwanted characters.
Thanks
If you want to replace bad characters with a single space:
Sub KeepOnlyTheGood()
Dim i As Long, L As Long, v As String, CH As String
Dim r As Range
For Each r In Selection
t = ""
v = r.Value
L = Len(v)
For i = 1 To L
CH = Mid(v, i, 1)
If CH Like "[0-9A-Z]" Or CH = "/" Or CH = "-" Or CH = "." Or CH = " " Or CH = "<" Or CH = "=" Then
t = t & CH
Else
t = t & " "
End If
Next i
r.Value = t
Next r
End Sub
Here's some VBA that will do it if you find regex difficult to understand. It uses the ASCII code to determine the only characters to allow. If your scope changes you can modify the ASCII numbers in the Case statement.
Public Function RemoveSpecial(s As String) As String
Dim sResult As String
Dim nIndex As Integer
s = UCase$(s)
For nIndex = 1 To Len(s)
Select Case Asc(Mid$(s, nIndex, 1))
Case 65 To 90, 45 To 57, 32, 60 To 61
sResult = sResult & Mid$(s, nIndex, 1)
Case Else
sResult = sResult & " "
End Select
Next
RemoveSpecial = sResult
End Function
Usage:
Debug.Print RemoveSpecial("TeSt<>=.##")
or something like:
Range("A1") = RemoveSpecial("TeSt<>=.##")
ASCII Codes
What it does: I have a section of code which finds a substring TL in a cell, and forces the numbers following it to be of length 6 by adding or deleting 0s immediately following "TL-". (ie TL-00072 -> TL-000072, TL-034 -> TL-000034, TL-000000789 -> TL-000789)
What I want it to do: However, sometimes there are multiple TL values in one cell. I need to find if there is a second occurance of TL, and, if yes, delete that second occurance and everything following it.
Example:
Start: Output:
TL-000789 TL-000187 TL-000773 -> TL-000789
TL-000689 TL -000787 -> TL-000689
TL-000982 TL - 980819 -> TL-000982
This is the attempt at code I have been working on (incorrect and not working) using split (maybe trim would work too?) that would find the second occurence of TL and delete everything after it. Full working code below that.
CURRENT ATTEMPT AT CODE
Dim splitValues As Variant
If Str(str, "TL" + 1) 'do not know how to get SECOND occurrence
splitValues = Split(theValue, "TL")
theValue = splitValues(0)
End If
WORKING CODE
[will add new code to beginning] (explanation at top of question)
NOTE: StartSht is the workbook where the values are as well as the code.
All values being altered are in column "C"
'force length of TL/CT to be 6/4 numbers long, eliminate spaces
Dim str As String, ret As String, tmp As String, j As Integer, k As Integer
For k = 2 To StartSht.Range("C2").End(xlDown).Row
ret = ""
str = StartSht.Range("C" & k).Value
'for TL numbers
''''''''''''''new code goes here''''''''''''''''''
If InStr(str, "TL") > 0 Then
For j = 1 To Len(str)
tmp = Mid(str, j, 1)
If IsNumeric(tmp) Then ret = ret + tmp
Next j
'force to 6 numbers if too short; add 0s immediately after "TL-"
For j = Len(ret) + 1 To 6
ret = "0" & ret
Next j
'force to 6 numbers if too long; eliminate 0s immediately after "TL-"
If Len(ret) > 6 Then
Debug.Print Len(ret)
For j = Len(ret) To 7 Step -1
If Mid(ret, 1, 1) = "0" Then
ret = Right(ret, j - 1)
End If
Next j
End If
'eliminate superfluous spaces around "TL-"
ret = "TL-" & ret
StartSht.Range("C" & k).Value = ret
'for CT numbers
ElseIf InStr(str, "CT") > 0 Then
For j = 1 To Len(str)
tmp = Mid(str, j, 1)
If IsNumeric(tmp) Then ret = ret + tmp
Next j
'force to 4 numbers if too short; add 0s immediately after "CT-"
For j = Len(ret) + 1 To 4
ret = "0" & ret
Next j
'force to 4 numbers if too long; eliminate 0s immediately after "CT-"
If Len(ret) > 4 Then
Debug.Print Len(ret)
For j = Len(ret) To 5 Step -1
If Mid(ret, 1, 1) = "0" Then
ret = Right(ret, j - 1)
End If
Next j
End If
'eliminate superfluous spaces around "CT-"
ret = "CT-" & ret
StartSht.Range("C" & k).Value = ret
End If
Next k
It looks like you could just redefine str if you find a second "TL". After the line:
If InStr(str, "TL") > 0 Then
add another IF statement:
If InStr(3, str, "TL") > 0 Then str = Mid(str, 1, Instr(3, str, "TL") - 2)
Then continue with the rest of your code using the new str.
I have an excel spreadsheet that contains entire addresses packed in a single cell without delimiters. The addresses look like this:
2701 NW 64TH TER MARGATE FL 33063-1703
901 NE 8 ST HALLANDALE BEACH FL 33009-2626
1840 DEWEY ST UNIT 305 HOLLYWOOD FL 33020
3049 NE 4 AVE WILTON MANORS FL 33334-2047
650 NE 56 CT OAKLAND PARK FL 33334-3528
So the first five cells in column A would contain the above addresses.
As you can see, some of the cities consist of two words but the state is always FL or NY. All I need to do is separate the address, city, state, and zip in their own columns. I'm hoping there's a way to do this in VBD (Visual Basic for Developers) in excel. So I can put it into a macro.
I have an idea of how it can be done, but my VBD is limited:
stateArray = Split("FL, NY")
cityArray = Split("Fort Lauderdale","Sunrise","Oakland Park")
For example, another programming language you might do something like this:
var arrStates, arrCities
arrCities = ["Fort Lauderdale", "Sunrise", "Oakland Park"]
arrStates = ["FL", "NY"]
var findAddress = function(curCity, curState){
for(var i=0; i < arrCities.length; i < arrStates.length; i--){
(arrCities[i] == curCity) ? arrCities[i] = CurCity : arrCities[i] = null;
(arrStates[i] == curState) ? arrStates[i] = curState : arrStates[i] = null;
}
if(arrCities[i] >= 0){
var city = arrCities[i];
}
if(arrStates[i] >= 0){
var state = arrStates[i];
}
createTable(city, state);
}
var createTable = function(city, state){
var tbl = document.createElement("Table");
var newRow = document.createElement("tr");
tbl.appendChild(newRow);
cols = [city, state];
for(var i=0; i < cols.length; i++){
var newCol = document.createElement("td");
newCol.innerText = cols[i];
newRow.appendChild(newCol);
}
}
Thanks for any response.
It seems that if you have to type out all the cities, you might as well just split all the cells manually. It may be easier to identify all the street types and use that as a delimiter. Note the spaces around the strings in the array.
Sub SplitAddresses()
Dim vaStates As Variant
Dim vaStreets As Variant
Dim i As Long
Dim rCell As Range
Dim sAddress As String
Dim sCity As String, sState As String
Dim sZip As String
Dim lStreetPos As Long, lStatePos As Long
vaStates = Array(" FL ", " NY ")
vaStreets = Array(" TER ", " ST ", " AVE ", " CT ")
For Each rCell In Sheet1.Range("A1:A5").Cells
sAddress = "": sCity = "": sZip = "": sState = ""
For i = LBound(vaStreets) To UBound(vaStreets)
lStreetPos = InStr(1, rCell.Value, vaStreets(i))
If lStreetPos > 0 Then
sAddress = Trim(Left$(rCell.Value, lStreetPos + Len(vaStreets(i)) - 1))
Exit For
End If
Next i
For i = LBound(vaStates) To UBound(vaStates)
lStatePos = InStr(1, rCell.Value, vaStates(i))
If lStatePos > 0 Then
sCity = Trim(Mid$(rCell.Value, Len(sAddress) + 1, lStatePos - Len(sAddress) - 1))
sState = Trim(Mid$(rCell.Value, lStatePos + 1, Len(vaStates(i)) - 1))
sZip = Trim(Mid$(rCell.Value, lStatePos + Len(vaStates(i)), Len(rCell.Value)))
Exit For
End If
Next i
rCell.Offset(0, 1).Value = "'" & sAddress
rCell.Offset(0, 2).Value = "'" & sCity
rCell.Offset(0, 3).Value = "'" & sState
rCell.Offset(0, 4).Value = "'" & sZip
Next rCell
End Sub
In situations like this I try to forget that I'm programming, and just think about what sort of thought processes I would use to figure out what each was normally.
2701 NW 64TH TER MARGATE FL 33063-1703
901 NE 8 ST HALLANDALE BEACH FL 33009-2626
1840 DEWEY ST UNIT 305 HOLLYWOOD FL 33020
3049 NE 4 AVE WILTON MANORS FL 33334-2047
650 NE 56 CT OAKLAND PARK FL 33334-3528
At 1st things may seem hectic, but if you look closer there are patterns.
The addresses all start with a set of #s as the start of the street address
The street address always ends in a street type abbreviation
If there is a unit of the building it is after the street address
The addresses all end with the zip code
Before the zip code is the state abbreviation
The City name is smack dab in the middle for the taking if everything else is stripped away.
This makes the pattern as follows
Street # : Street Type : Unit {Optional} : City : State: Zip Code
Strip each piece off of a temporary string variable using string functions and you should be able to rebuild it fairly easily.
Hope that helps.
Here is some VBA code to get you started: you would need to add error handling
Option Explicit
Option Compare Text
Sub SplitAddress()
Dim vStates As Variant
Dim vCities As Variant
Dim vInput As Variant
Dim vAddress() As Variant
Dim j As Long
Dim str1 As String
' States/Cities/Inputs are named ranges containing the data
vStates = [States]
vCities = [Cities]
vInput = [Inputs]
ReDim vAddress(1 To UBound(vInput) - LBound(vInput) + 1, 1 To 4)
For j = 1 To UBound(vInput)
str1 = Trim(CStr(vInput(j, 1)))
If Len(str1) = 0 Then Exit For
FindSplit j, 3, str1, vStates, vAddress()
FindSplit j, 2, str1, vCities, vAddress()
Next j
ActiveSheet.Range("A2").Resize(UBound(vAddress), UBound(vAddress, 2)) = vAddress
End Sub
Sub FindSplit(j As Long, k As Long, str1 As String, vItems As Variant, vAddress() As Variant)
Dim iPos As Long
Dim jItem As Long
Dim strItem As String
For jItem = 1 To UBound(vItems)
strItem = Trim(CStr(vItems(jItem, 1)))
iPos = InStr(str1, " " & strItem & " ")
If iPos > 0 Then
vAddress(j, k) = Mid(str1, iPos + 1, Len(strItem))
If k = 3 Then
vAddress(j, k + 1) = Right(str1, Len(str1) - (iPos + 3))
str1 = Left(str1, iPos)
Else
vAddress(j, 1) = Left(str1, iPos - 1)
End If
Exit For
End If
Next jItem
End Sub