Macro to format text

[Zak]

I have a few formatting requirements for my spreadsheet and i was wondering
if you can help:

1-if name in column C appears as: Joe Bloggs/UK/SC/CSC then everything from
the first / onwards needs to be deleted.
2- if in column C something appears as: (e-mail address removed) then everything
from @ onwards must be deleted, the dot replaced with a space and the 1st
letter of each name to be changed to capital - so should look like: Joe
Bloggs.
3-if a cell in column c is blank and the corresponding cells in columns A &
B arent (should contain first name and second name in A & B)then A & B must
be concatenated with a space (to make first name and second name come
together) and then instert into the coresponding cell in column C.
4- if A,B & C are all blank then the the word 'Vacancy' should be inserted
in column C
5- if anything in column E is as: joe.bloggs then this should be changed to
replace dot with space and again as above make the j a capital J and the h a
capital H.

i hope you can offer some help.

thanks alot.

 

[Joel]

I didn't get to test the code put it is something like thjis. A little
complicated

Sub fixname()
CharA = Asc("a")

LastRow = Range("C" & Rows.Count).End(xlUp).Row
For RowCount = 1 To LastRow
ColCData = Range("C" & RowCount)
Fixed = False
If InStr(ColCData, "/") > 0 Then
ColCData = Left(ColCData, InStr(ColCData, "/") - 1)
Fixed = True
End If
If (Fixed = False) And (InStr(ColCData, "@") > 0) Then
atposition = InStr(ColCData, "@")
ColCData = Left(ColCData, atposition - 1)
dotposition = InStr(ColCData, ".")
ColCData = Replace(ColCData, ".", " ")
Leftchar = Left(ColCData, 1)
CharLetter = Chr(Leftchar)
CharNum = Asc(CharLetter)
If CharNum >= CharA Then
CharLetter = Chr(CharNum - CharA)
ColCData = CharLetter & Mid(ColCDate, 2)
End If
Leftchar = Mid(ColCData, dotposition + 1, 1)
CharLetter = Chr(Leftchar)
CharNum = Asc(CharLetter)
If CharNum >= CharA Then
CharLetter = Chr(CharNum - CharA)
ColCData = Left(ColCData, dotposition) & _
CharLetter & Mid(ColCDate, dotposition + 2)
End If
Fixed = True
End If
If (Fixed = False) And (ColCData = "") And _
((Range("A" & RowCount) <> "") Or _
(Range("B" & RowCount) <> "")) Then

ColCData = Range("A" & RowCount) & " " & _
Range("B" & RowCount)
Fixed = True
End If
If (Fixed = False) And (ColCData = "") And _
((Range("A" & RowCount) = "") Or _
(Range("B" & RowCount) = "")) Then

ColCData = "Vacancy"
Fixed = True
End If
Range("C" & RowCount) = ColCData

ColEData = Range("E" & RowCount)
If InStr(ColEData, ".") > 0 Then
dotposition = InStr(ColEData, ".")
ColEData = Replace(ColEData, ".", " ")
Leftchar = Left(ColEData, 1)
CharLetter = Chr(Leftchar)
CharNum = Asc(CharLetter)
If CharNum >= CharA Then
CharLetter = Chr(CharNum - CharA)
ColEData = CharLetter & Mid(ColEDate, 2)
End If
Leftchar = Mid(ColEData, dotposition + 1, 1)
CharLetter = Chr(Leftchar)
CharNum = Asc(CharLetter)
If CharNum >= CharA Then
CharLetter = Chr(CharNum - CharA)
ColEData = Left(ColEData, dotposition) & _
CharLetter & Mid(ColEDate, dotposition + 2)
End If
Range("E" & RowCount) = ColEData
End If
Next RowCount
End Sub

 

[Ron Rosenfeld]

I have a few formatting requirements for my spreadsheet and i was wondering
if you can help:

1-if name in column C appears as: Joe Bloggs/UK/SC/CSC then everything from
the first / onwards needs to be deleted.
2- if in column C something appears as: (e-mail address removed) then everything
from @ onwards must be deleted, the dot replaced with a space and the 1st
letter of each name to be changed to capital - so should look like: Joe
Bloggs.
3-if a cell in column c is blank and the corresponding cells in columns A &
B arent (should contain first name and second name in A & B)then A & B must
be concatenated with a space (to make first name and second name come
together) and then instert into the coresponding cell in column C.
4- if A,B & C are all blank then the the word 'Vacancy' should be inserted
in column C
5- if anything in column E is as: joe.bloggs then this should be changed to
replace dot with space and again as above make the j a capital J and the h a
capital H.

i hope you can offer some help.

thanks alot.

==========================
Option Explicit
Sub fText()
Dim c As Range
Dim l As Long, a As Long
For Each c In Range("C1:C10")
l = InStr(1, c.Value, "/")
a = InStr(1, c.Value, "@")
If l > 0 Then
c.Value = Left(c.Value, l - 1)
ElseIf a > 0 Then
c.Value = Application.WorksheetFunction.Proper _
(Replace(Left(c.Value, a - 1), ".", " "))
ElseIf Len(c.Text) = 0 And Len(c.Offset(0, -2).Text) > 0 And _
Len(c.Offset(0, -1)) > 0 Then
c.Value = c.Offset(0, -2).Value _
& " " & c.Offset(0, -1).Value
ElseIf Len(c.Offset(0, -2).Text & c.Offset(0, -1).Text & c.Text) = 0
Then
c.Value = "Vacancy"
End If

'Now check column E
If c.Offset(0, 2).Text Like "*.*" Then
c.Offset(0, 2).Value = Application.WorksheetFunction.Proper _
(Replace(c.Offset(0, 2).Text, ".", " "))
End If
Next c
End Sub
=================================
--ron

 

[Gemz]

Code did not work. it gave me TYPE MISMATCH error 13. and it highlighted line

'CharLetter = Chr(Leftchar)' - which is somewhere in the middle of the code.

i also checked the other code sent by Ron but that didnt work either, i am
going to reply to that with the error now too.

please help.

thanks.

 

[Gemz]

The code did not work, the following line was highlighted in red:

ElseIf Len(c.Offset(0, -2).Text & c.Offset(0, -1).Text & c.Text) = 0
Then

i tried to move it back or forward a little incase it was messing with the
syntax but it didnt work.

the other code given by Joel didnt work either, i have emailed him too.

Please help! thanks.

 

[Rick Rothstein \(MVP - VB\)]

Give this a try...

Sub FixNames()
Dim LastColumnInAB As Long
Dim LastColumnInC As Long
Dim LastColumnInE As Long
Dim Position As Long
Dim MaxCol As Long
Dim Cel As Range
LastColumnInAB = Cells(Rows.Count, "A").End(xlUp).Row
LastColumnInC = Cells(Rows.Count, "C").End(xlUp).Row
LastColumnInE = Cells(Rows.Count, "E").End(xlUp).Row
If LastColumnInAB > LastColumnInC Then
MaxCol = LastColumnInAB
Else
MaxCol = LastColumnInC
End If
For Each Cel In Range("C1:C" & MaxCol)
If Len(Cel.Value) = 0 Then
Cel.Value = Trim$(Cells(Cel.Row, "A") & " " & Cells(Cel.Row, "B"))
If Len(Cel.Value) = 0 Then Cel.Value = "Vacancy"
Else
Position = InStr(Cel.Value, "/")
If Position = 0 Then Position = InStr(Cel.Value, "@")
If Position > 0 Then Cel.Value = StrConv(Replace(Left$(Cel.Value, _
Position - 1), ".", " "), vbProperCase)
End If
Next
For Each Cel In Range("E1:E" & LastColumnInE)
Cel.Value = StrConv(Replace(Cel.Value, ".", " "), vbProperCase)
Next
End Sub

Rick

 

[Gemz]

thanks so much for the quick reply but this code only works partially..

-it works fine for most steps(conditions) but doesnt do anything with:

3-if a cell in column c is blank and the corresponding cells in columns A &
B arent (should contain first name and second name in A & B)then A & B must
be concatenated with a space (to make first name and second name come
together) and then instert into the coresponding cell in column C.
4- if A,B & C are all blank then the the word 'Vacancy' should be inserted
in column C.

weirdly the above to steps in the code dont work. why?

thanks alot.

 

[Rick Rothstein \(MVP - VB\)]

When you say "blank", you do mean with **nothing**, not even a blank space,
in the the cell, correct? You are saying my code doesn't do steps 3 and 4 at
all, anywhere on your sheet? As far as I can tell from my own testing, the
code I posted **does** do both steps number 3 and 4 correctly.

Can you post a copy of your spreadsheet (the one where you say it doesn't
work) on a webpage so I, and others, can test our code against your actual
data conditions? If not, then email me a copy of your spreadsheet (remove
the NOSPAM stuff from my email address) so I can try it out against me own
code. Please reply to this message with either way you proceed (so if you
are emailing it to me, I'll know to look out for it).

Rick

 

[Ron Rosenfeld]

The code did not work, the following line was highlighted in red:

ElseIf Len(c.Offset(0, -2).Text & c.Offset(0, -1).Text & c.Text) = 0
Then

i tried to move it back or forward a little incase it was messing with the
syntax but it didnt work.

Darn word wrap: The "Then" should be on the same line as the Elseif STatement

So position your cursor at the "0" at the end of the elseif line, and <del>
until the "Then" comes up to the same line.
--ron

 

[Gemz]

Hi,

I just realised what the problem was.. the thing is the blank cells look
blank but actually contain some sort of formatting (that we cant see in cell)
i just wanted to see if this was the issue and when i did Edit-clear format
and then ran the macro the macro worked. so how can i tell the macro to clear
the formats of the cells first and then do the replacing? because without
having cleared the format the macro doesnt seem to work even though the cells
are blank, didnt think formatting would get in the way.

if you know how i can put it in the code to clear format then i wont need to
email you my file.

thanks so much.

 

[Rick Rothstein \(MVP - VB\)]

Just so we can duplicate your conditions... what was the formatting you had
in the cells?

Rick

 

[Gemz]

i Hi,

i just sent you a sample spreadsheet on ur email, i didnt know how to check
the formatting coz when i checked it didnt show anything.

thanks alot

 

[Rick Rothstein \(MVP - VB\)]

When I put the code I posted in the code window for the worksheet you want
to apply it to, then the code works fine without having to clear any
formatting. I'm guessing you are running the code from a different code
window (perhaps from a Module?) and that is why it is not working. Here is a
revision to my code which will run against the active worksheet from any
code window (without needing to clear the formats); so make sure you are on
the worksheet you want to fix the names on before you run it...

Sub FixNames()
Dim LastColumnInAB As Long
Dim LastColumnInC As Long
Dim LastColumnInE As Long
Dim Position As Long
Dim MaxCol As Long
Dim Cel As Range
With ActiveSheet
LastColumnInAB = .Cells(.Rows.Count, "A").End(xlUp).Row
LastColumnInC = .Cells(.Rows.Count, "C").End(xlUp).Row
LastColumnInE = .Cells(.Rows.Count, "E").End(xlUp).Row
If LastColumnInAB > LastColumnInC Then
MaxCol = LastColumnInAB
Else
MaxCol = LastColumnInC
End If
For Each Cel In .Range("C1:C" & MaxCol)
If Len(Cel.Value) = 0 Then
Cel.Value = Trim$(.Cells(Cel.Row, "A") & " " & .Cells(Cel.Row, "B"))
If Len(Cel.Value) = 0 Then Cel.Value = "Vacancy"
Else
Position = InStr(Cel.Value, "/")
If Position = 0 Then Position = InStr(Cel.Value, "@")
If Position > 0 Then Cel.Value = StrConv(Replace(Left$(Cel.Value, _
Position - 1), ".", " "), vbProperCase)
End If
Next
For Each Cel In .Range("E1:E" & LastColumnInE)
Cel.Value = StrConv(Replace(Cel.Value, ".", " "), vbProperCase)
Next
End With
End Sub

Rick

 

[Gemz]

Brilliant!!
It works fine, yes i did put the code in a module.

Thanks a lot for all your help.