Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Stripping characters from strings and writing contents to another
Hi
I am new to Visual Basic, but I have a worksheet with the following text in one cell of each row. I would like to strip out the first number and place in another cell to the right, then strip out the second number and place in it's own cell on the right as well. Repeat the process for each row. Wk17 to Wk21 Wk17 to Wk21 Wk17 to Wk21 Wk2 to Wk21 Wk17 to Wk21 Wk17 to Wk21 Any ideas? Thanks in advance for your help. Adam |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Stripping characters from strings and writing contents to another
Hi Batman.
In a stamdard module (See below), paste the following code: '============ Option Explicit Public Sub Tester() Dim WB As Workbook Dim SH As Worksheet Dim Rng As Range Dim rCell As Range Dim sStr As String Dim arr As Variant Set WB = Workbooks("Book1") '<<==== CHANGE Set SH = WB.Sheets("Sheet1") '<<==== CHANGE With SH iRow = lastrow(SH, .Range("A:A")) Set Rng = SH.Range("A1:A" & iRow) End With For Each rCell In Rng.Cells With rCell sStr = Replace(.Value, "Wk", vbNullString) arr = Split(sStr, "to") .Offset(0, 1).Resize(1, 2).Value = _ Array(arr(0), arr(1)) End With Next rCell End Sub '--------------- Function lastrow(SH As Worksheet, _ Optional Rng As Range) If Rng Is Nothing Then Set Rng = SH.Cells End If On Error Resume Next lastrow = Rng.Find(What:="*", _ After:=Rng.Cells(1), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function '<<============ Alt-F11 to open the VBA Editor Menu | Insert | Module | Paste the above code Alt-F11 to return to Excel Alt-F8 to open the macro window Select "Tester" | Run --- Regards. Norman "BatmanFromOz" wrote in message ... Hi I am new to Visual Basic, but I have a worksheet with the following text in one cell of each row. I would like to strip out the first number and place in another cell to the right, then strip out the second number and place in it's own cell on the right as well. Repeat the process for each row. Wk17 to Wk21 Wk17 to Wk21 Wk17 to Wk21 Wk2 to Wk21 Wk17 to Wk21 Wk17 to Wk21 Any ideas? Thanks in advance for your help. Adam |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Stripping characters from strings and writing contents to another
Hi Batman
I omitted to declare my iRow variable; insert: Dim iRow As Long After: Dim arr As Variant --- Regards. Norman |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Stripping characters from strings and writing contents to anot
Wow it works. You are fantastic and I really appreciate it.
You even provided instructions on how to launch the editor etc. Thankyou very much!! Adam :) |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Stripping characters from strings and writing contents to another
On Sun, 8 Jun 2008 22:33:00 -0700, BatmanFromOz
wrote: Hi I am new to Visual Basic, but I have a worksheet with the following text in one cell of each row. I would like to strip out the first number and place in another cell to the right, then strip out the second number and place in it's own cell on the right as well. Repeat the process for each row. Wk17 to Wk21 Wk17 to Wk21 Wk17 to Wk21 Wk2 to Wk21 Wk17 to Wk21 Wk17 to Wk21 Any ideas? Thanks in advance for your help. Adam If you want to leave the original unchanged, and just extract the two numbers, you can also do it with formulas: First number: =LOOKUP(9.9E+307,--MID(A1,MIN(SEARCH({0,1,2,3,4,5,6,7,8,9},A1&" 0123456789")),ROW(INDIRECT("1:"&LEN(A1))))) 2nd number (first number after the <space: =LOOKUP(9.9E+307,--MID(A1,MIN(SEARCH({0,1,2,3,4,5,6,7,8,9},A1&" 0123456789",FIND(" ",A1))),ROW(INDIRECT("1:"&LEN(A1))))) Another VBA method, written as a macro: Examine the comments for certain techniques that may be of value. There are many ways to decide if the data is valid, and/or to set up the range on which to operate. ==================================== Option Explicit Sub ExtrNums() Dim c As Range, rSrc As Range Dim re As Object, mc As Object 'Expand selection to include Current Region ' so selection could be just one cell 'Then resize to operate only on the leftmost ' column Set rSrc = Selection.CurrentRegion Debug.Print rSrc.Address Set rSrc = rSrc.Resize(, 1) Debug.Print rSrc.Address Set re = CreateObject("vbscript.regexp") re.Global = True re.Pattern = "\d+" For Each c In rSrc 'clear the two cells to the right Range(c(1, 2), c(1, 3)).Clear Set mc = re.Execute(c.Value) 'make sure there are two numbers in the original source If mc.Count = 2 Then c.Offset(0, 1).Value = CDbl(mc(0)) c.Offset(0, 2).Value = CDbl(mc(1)) End If Next c End Sub ========================================== --ron |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Stripping out characters | Excel Worksheet Functions | |||
Stripping The First Four Characters from a value | Excel Discussion (Misc queries) | |||
Writing Localized Strings In Cells Using Automation | Excel Discussion (Misc queries) | |||
Stripping out contents of a cell after 8 characters? | Excel Programming | |||
Writing strings to a text file ? | Excel Programming |