MID macro

[Rasmus]

Man, I hope someone can help me out with this one. I'm trying to isolate
part of some cells using the MID function. This works fine manually in a
cell (D14):

=MID(C14;1;FIND("/";C14;1)-1)

The value in D14 will be "Full Metal Jacket"
if C14 = "Full Metal Jacket / Fullscreen Edition"

I've tried to work this into a macro like so (so that the original value is
trimmed and overwritten):

Sub MIDTEST()
intTotalPos = 14
Range("c" & intTotalPos).Select
Do
Range("c" & intTotalPos).Select
ActiveCell = Mid(ActiveCell, 1, .Find("/", ActiveCell, 1) - 1)
Range("c" & intTotalPos).Select
Loop Until ActiveCell = ""
End Sub

It's obviously this line that screws the whole thing up:
ActiveCell = Mid(ActiveCell, 1, .Find("/", ActiveCell, 1) - 1)

I've tried messing about with it, but I'm lost. Can anyone help, please ?

(c:
Rasmus

 

[David Coleman]

Hi Rasmus

Your request isn't clear as to whether C14 should be overwritten with the
new value or whether the new value should go into D14.

Anyway, the following code loops through all values in Col C (looping from 1
until a blank cell is reached) and copies the bit before the slash (if
present at all) to the same row in Col D.

If no slash is present, nothing is copied to Col D and if there is more than
one slash in the cell then only the first bit is copied across - let me know
if this isn't as you need.



Sub MIDTEST()
intTotalPos = 1
Do
on error resume next
Range("d" & intTotalPos).Value = Mid(Range("c" & intTotalPos), 1, _
Application.WorksheetFunction.Find("/", Range("c" &
intTotalPos).Value) - 2)
intTotalPos = intTotalPos + 1
Loop Until Range("c" & intTotalPos).Value = ""
End Sub



Regards

David

 

[Bob Phillips]

Rasmus,

Here's a simple version that uses just VBA, no worksheet functions.

Sub MIDTEST()
Dim intTotalPos As Integer

intTotalPos = 14
Do Until Range("c" & intTotalPos).Value = ""
With Range("c" & intTotalPos)
.Value = Mid(ActiveCell, 1, InStr(1, .Value, "/") - 1)
End With
intTotalPos = intTotalPos + 1
Loop
End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)