Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 8 years ago.
Improve this question
It seemed like a simple code but I couldn't find it anywhere on the net & I don't know how to write it.
What I want to do is that, say, cell range A1 has a value of "Hey ho he ha".
What I want the code to do is to remove away the rest of the word after the 1st space, so what's left will be with only "Hey".
Thanks!
One line Code...
Range("A1").Value = Split(Range("A1").Value, " ")(0)
Another one line code (based on IolandaAB's answer)
If InStr(1, Range("A1").Value, " ") Then Range("A1").Value = Mid(Range("A1").Value, 1, InStr(1, Range("A1").Value, " ") - 1)
And yet another one line code
If InStr(1, Range("A1").Value, " ") Then Range("A1").Value = Left(Range("A1").Value, InStr(1, Range("A1").Value, " ") - 1)
Take your pick :) My favorite is still the first one.
Sub extract()
Dim myString As String, lung As Integer, i As Integer, pos As Integer
myString = Range("A1").value
lung = Len(myString)
For i = 1 To lung
pos = InStr(i, myString, " ")
If pos <> 0 Then
Exit For
End If
Next i
Range("A1").value = Mid(myString, 1, pos)
End Sub
Loop through the value from your cell and exit when the first space is found in your text. Extract the text before the found space and copy this in your cell.
Related
Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 7 months ago.
Improve this question
For an example if column value is "ABC 123 981" need to extract only 123... like so if its "456_wert" need to extract only 456 using access VBA code. Can somebody please help on this.
Parse First Consecutive Digits
Sub StrFirstDigitsTEST()
Const pString As String = "a123.456b"
Dim rString As String: rString = StrFirstDigits(pString)
Debug.Print rString, Len(rString)
' Result:
' 123 3
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Returns a string's ('ParseString') first consecutive digits
' in a string.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function StrFirstDigits(ByVal ParseString As String) As String
Dim ResultString As String
Dim Char As String
Dim FoundDigit As Boolean
Dim n As Long
For n = 1 To Len(ParseString)
Char = Mid(ParseString, n, 1)
If Char Like "#" Then
If Not FoundDigit Then FoundDigit = True
ResultString = ResultString & Char
Else
If FoundDigit Then Exit For
End If
Next n
StrFirstDigits = ResultString
End Function
Parsing strings is fairly simple if data has a consistent structure. Does not seem to be the case here so gets complicated. Your second example could be accomplished with Val("456_wert") but because the first example does not follow same pattern, will require more complex code. Probably have to test each character until a number is encountered. Based on samples provided, something like:
Function GetNumber(varS As Variant) As Variant
Dim x As Integer
GetNumber = Null
If varS & "" Like "*#*" Then
For x = 1 To Len(varS)
If IsNumeric(Mid(varS, x, 1)) Then
GetNumber = Val(Mid(Replace(varS, " ", "|"), x))
Exit For
End If
Next
End If
End Function
Place the procedure in a general module and call it from query or textbox.
SELECT table.*, GetNumber([source field]) AS Nbr FROM table;
=GetNumber([sourcefield])
Shouldn't really be necessary to populate a field in table with this extract, however, the SQL would be:
UPDATE tablename SET fieldname = GetNumber([source field])
I have a sheet in which our wholesale team are to enter L09 Part Codes and quickly see how much we have in stock of that item. The problem is that new starters may struggle to learn these part numbers as they don't follow a simple rule. What I did was create an easier code to remember which is simply: "Cable Type" & "Core Size" & "Cut Length", they also have the option to add "Colour" and "Brand" separated by spaces.
Their entered string may look like 6242y 2.5 100, or maybe 6242y 2.5 100 Grey, etc. and so where to look in my mapped table for what they've written depends on how many terms they put in. As you can see from the attached picture I need to select the correct column to look in for their code, and then offset back a few columns to suggest the correct L09 Part Number.
I hope the context makes a bit of sense and helps with the below code. The idea was for a new starter to enter something simple and it be replaced before their very eyes...
If anyone could help me to correct the following it would be greatly appreciated:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim P, Products, S, Search As Range
Dim Column As String
Dim Counter As Integer
Dim Spaces As Long
'On Error Resume Next
Counter = 0
'For top table only
If Target.Column = 1 And Target.Row < 100 Then
'Count spaces
Spaces = UBound(Split(Target, " "), 1)
Select Case Spaces
Case Is = 2
Column = "M"
Case Is = 3
Column = "O"
Case Is = 4
Column = "Q"
End Select
'When string has spaces
If Spaces <> 0 Then
'Set simple code range
Set Search = Sheets("Cherries").Range(Column & 1 & ":" & Column & 10000)
For Each S In Search
If S = Target Then
Target = S.Offset(0, 3 - 2 * Spaces)
End If
Next S
End If
Set Products = Sheets("Order Entry").Range("A3:A99")
For Each P In Products
If P.Value <> "" Then
Counter = Counter + 1
End If
Next P
Sheets("Order Entry").Rows("3:" & Counter + 11).Hidden = False
Sheets("Order Entry").Rows(Counter + 11 & ":99").Hidden = True
End If
End Sub
Unfortunately I'm not sure which line is erroring as no error message is given.
Thank you for your time.
Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 4 years ago.
Improve this question
I need to remove emojis from a csv with 100.000 lines.
Any suggestion?
I've tried some VBA code I found online but didn't work.
Thanks
There is no evidence that you've made an attempt to solve this yourself, and the question is missing several key pieces of information, so I'm not sure if this is actually what you're trying to do.
However, I just happened to be stripping specific characters from "very large" text files, so perhaps this code will help.
QuickReplace in Text File
This reads a text file quickly into a byte array, then dumps into a second byte array, skipping specific characters, then convert the array to a string before saving the file with a new name.
Const fileIn = "x:\myPath\myInputFile.txt"
Const fileOut = "x:\myPath\myOututFile.txt"
Sub stripChars()
Dim bytesIn() As Byte, bytesOut() As Byte
Dim x As Long, y As Long, txtOut As String, fileSize As Long
Debug.Print fileIn & " : Reading Data, ";
Open fileIn For Binary Access Read As #1
fileSize = LOF(1) 'read bytes from file
ReDim bytesIn(fileSize - 1&)
Get #1, , bytesIn
Close #1
Debug.Print "Cleaning, ";
ReDim bytesOut(LBound(bytesIn) To UBound(bytesIn))
For x = LBound(bytesIn) To UBound(bytesIn)
Select Case bytesIn(x)
Case 9, 10, 13 To 126 'retain only specific ASCII characters
bytesOut(y) = bytesIn(x)
y = y + 1
Case Else
'do nothing (skip byte)
End Select
If x / 1000000 = x \ 1000000 Then
DoEvents 'update status bar, every 1m char
Application.StatusBar = "Cleaning: " & Format(x / fileSize, "0.0%")
End If
Next x
ReDim Preserve bytesOut(LBound(bytesOut) To y - 1) 'resize
txtOut = StrConv(bytesOut, vbUnicode) 'convert byte array to string
If Dir(fileOut) <> "" Then Kill fileOut 'delete output file if it exists
Debug.Print "Saving, ";
Open fileOut For Output As #2
Print #2, txtOut 'write to output file
Close #2
Application.StatusBar = "Finished! (Removed " & _
fileSize - FileLen(fileOut) & " bytes)"
Debug.Print "Done."
End Sub
Alternatively there are several worksheet functions that can be used to clean test.
See "Top 10 Ways To Clean Your Data."
I have a number of items in cells that are separated by dashes. I'm trying to normalize the database by splitting rows so that each row contains only one entry. How do you find/count strings in Excel VBA. I know you can do values for whole cells with
myVar = Application.WorksheetFunction.COUNTIF(Range("A1:Z100"),"Value")
I need to search a single cell and find out how many hyphens there are. Example
123-456-789 = 2
9876-12 = 1
Using hint from ron's function above I've created this formula and it worked fine :
=LEN(A1) - LEN(SUBSTITUTE(A1, "-", ""))
This will count the number of hyphens in the activecell
Sub test()
a = Len(ActiveCell)
my_txt = Replace(ActiveCell, "-", "", 1, -1, vbTextCompare)
b = Len(my_txt)
numb_occur = a - b
End Sub
Here's the UDF to count single string occurence in string:
Option Explicit
Function COUNTTEXT(ref_value As Range, ref_string As String) As Long
Dim i As Integer, count As Integer
count = 0
If Len(ref_string) <> 1 Then COUNTTEXT = CVErr(xlErrValue): Exit Function
For i = 1 To Len(ref_value.value)
If Mid(ref_value, i, 1) = ref_string Then count = count + 1
Next
COUNTTEXT = count
End Function
Here's using Array formula:
=SUM(IF(ISERROR(SEARCH("-",MID(A1,ROW(INDIRECT("$1:$" & LEN(A1))),1))),0,1))
Entered using Ctrl+Shift+Enter.
Hope this helps.
I found this answer:
Sub xcountCHARtestb()
'If countCHAR(RANGE("aq528"), ".") > 0 Then 'YES
If countCHAR(Selection, ".") > 0 Then 'YES
MsgBox "YES" & Space(10), vbQuestion ', "title"
Else
MsgBox "NO" & Space(10), vbQuestion ', "title"
End If
End Sub
Sub xcountCHARtesta() 'YES
MsgBox "There are " & countCHAR(Selection, "test") & " repetitions of the character string", vbQuestion 'YES
End Sub
Function countCHAR(myString As String, myCHAR As String) As Integer 'as: If countCHAR(Selection, ".") > 1 Then selection OR RANGE("aq528") '"any char string"
countCHAR = UBound(split(myString, myCHAR)) 'YES
End Function
This code might be of your help .. you can also use it as a UDF... :)
Function CountHypens(rng_Src As Range) As Long
'A VARIANT FOR SPLITTING CELL CONTENTS
Dim var As Variant
On Error Resume Next
var = Split(rng_Src.Value, "-", , vbTextCompare)
If Err.Number <> 0 Then
Debug.Print "This cell does not have any hyphens."
Else
CountHypens = UBound(var)
End If
Err.Clear: On Error GoTo 0
End Function
Follow up to: davex, by davex.. :)
I had been looking all over trying to find a way to test same for find text string in a formula.
This answer seems to work correctly for both formulas / not & fits in a 1 liner..
(am still pretty novice at vba, let me know if any better way(s) ) thanks.
If countChar(UCase(Selection.Formula), UCase("offset")) > 0 Then 'YES (thee? answer, works for both formulas / not)
'If countChar(Selection.Formula, "OFFSET") > 0 Then 'yes
'If countChar(Cells(ActiveCell.row, Selection.Column).Formula, "OFFSET") > 0 Then 'yes
'If countChar(Cells(ActiveCell.row, "BG").Formula, "OFFSET") > 0 Then 'yes
'If countChar(UCase(Selection), UCase("OffSET")) > 0 Then 'yes but not work on formula
'If Selection.Formula Like "*offset*" Then 'no (for eq)
MsgBox "YES" & Space(15), vbQuestion
Else
MsgBox "NO" & Space(15), vbQuestion
End If
NOTE: in place of variable "BG" above, i use permanent work cells to improve use for column BG example, work cell A3 has / shows: BG:BG
=SUBSTITUTE(SUBSTITUTE(CELL("address",$BG3),"$",""),ROW(),"")&":"&SUBSTITUTE(SUBSTITUTE(CELL("address",$BG3),"$",""),ROW(),"")
you will also need to dim the work cell, at the top / before the vba:
Dim A3 As String
A3 = RANGE("A3")
pardon, tried 3 times to get all of code into 1 box. really suggest putting a code stop start icon in the toolbar.
I'm working on changing an Access 2010 report. There is a portion of the report that reads in Raw Data from a SharePoint field called "Notes" that has comments for each record. Within the "notes" field, there can be several sentences. I need to find a way to separate those sentences into a bullet point per sentence in my report.
I'm trying to come up with a clever way to do so. I can get the data entry folks to use a symbol of some sort in the raw that signifies the need for a new bullet. This way, in my Report Expression (or perhaps via VBA), I can get it separated... but how?
Any thoughts?
The memo data field in MS Access can be set to Rich Text as a property, so:
UPDATE Table1
SET Table1.AMemo = "<ul><li>" &
IIf(InStr([AMemo],".")>0,
Replace(Mid([AMemo],1,Len([AMemo])-1),".","</li>"),[AMemo]) & "</li></ul>"
In its most rudimentary form you could do something like the following. Is splits the [Notes] text on ". " and creates a separate "point" for each sentence.
Sample Data: [SharePointData]
SlideNumber Notes
----------- ------------------------------------
1 Title slide.
2 Brief overview. Just the highlights.
3 More stuff.
VBA Code:
Option Compare Database
Option Explicit
Public Function SplitNoteText(RawText As Variant) As Variant
Dim rtn As Variant, StringArray() As String, Point As Variant
Const BulletChar = "-"
rtn = Null
If Not IsNull(RawText) Then
rtn = ""
StringArray = Split(RawText, ". ", -1, vbBinaryCompare)
For Each Point In StringArray
If Len(Point) > 0 Then
If Len(rtn) > 0 Then
rtn = rtn & vbCrLf & vbCrLf
End If
rtn = rtn & BulletChar & " " & Point
If Right(Point, 1) <> "." Then
' add back the period that got "consumed" in the Split
rtn = rtn & "."
End If
End If
Next
End If
SplitNoteText = rtn
End Function
Test query:
SELECT SlideNumber, Notes, SplitNoteText(Notes) AS Points FROM SharePointData;
Results:
SlideNumber Notes Points
----------- ------------------------------------ ----------------------
1 Title slide. - Title slide.
2 Brief overview. Just the highlights. - Brief overview.
- Just the highlights.
3 More stuff. - More stuff.