(in)definite article and leading/trailing space remover needed


K

KHashmi316

In order to better alphabetize a books database, I would like to use a
macro that checks for and deletes all titles that BEGIN with "The",
"An", "A", etc. IOW, if the first word in the cell is an (in)definite
article.

It would help if this SAME macro did a pre-scan for leading and
trailing spaces, and deleted them accordingly.

Finally, this macro would be most convenient if worked after selecting
a column.

Thx for any input you can provide on creating such a macro!
 
Ad

Advertisements

J

JMB

be sure to back up your data in case this is not what you want. any leading
words to be deleted, just add to Array1 (in quotes, separated by comma).

Sub Test()
Dim Array1()

On Error Resume Next
Array1 = Array("The", "A", "An")

For Each x In Selection
x.Value = Trim(x.Value)
For Each y In Array1
If (UCase(Left(x.Value, InStr(1, x.Value, " ", vbTextCompare) - 1)) =
UCase(y)) _
And (InStr(1, x.Value, " ", vbTextCompare) - 1 > 0) Then
x.Value = Trim(Replace(x.Value, y, "", 1, 1, vbTextCompare))
Exit For
End If
Next y
Next x

End Sub
 
J

JMB

when you paste the code into a module, make sure this line appears on one
line. when i posted it got wrapped to the next line (and it's not supposed
to be).

If (UCase(Left(x.Value, InStr(1, x.Value, " ", vbTextCompare) - 1)) =
UCase(y)) _
 
R

Robin Hammond

Why not do it as a UDF? You can then enter it in your sheet as a function,
or use it as a macro as shown below.

Option Private Module
Option Explicit
Option Compare Text

Public Function ParseIndefinites(vValue As Variant) As Variant
Dim vIndefs As Variant
Dim vTest As Variant

vIndefs = Array("The ", "An ", "A ")
vValue = Trim(vValue)

For Each vTest In vIndefs

If InStr(vValue, vTest) = 1 Then

ParseIndefinites = Mid(vValue, Len(vTest) + 1) & ", " & vTest
Exit Function

End If

Next vTest
ParseIndefinites = vValue
End Function

Sub Parse()
Dim rngCell As Range
Dim rngTest As Range

For Each rngCell In Intersect(Sheets(1).Columns(1).EntireColumn,
Sheets(1).UsedRange).Cells
If Not IsEmpty(rngCell.Value) Then rngCell.Value =
ParseIndefinites(rngCell.Value)
Next rngCell
End Sub


Robin Hammond
www.enhanceddatasystems.com
 
K

KHashmi316

JMB said:
when you paste the code into a module, make sure this line appears on
one
line. when i posted it got wrapped to the next line (and it's not
supposed
to be).

If (UCase(Left(x.Value, InStr(1, x.Value, " ", vbTextCompare) - 1)) =
UCase(y)) _


Thx for helping out.

I tried to run this but keep running into 'Variable not defined' error
for "x" in this line:

For Each x In Selection

Any clues?
 
Ad

Advertisements

K

KHashmi316

Robin,

Thx for your reply.

I tried to enter your suggestion into the VBA editor a number of ways,
but could not get it to work. No error messages, no action of any kind
AFAICS. I probably misunderstood your instructions.

What did you have in mind if one wishes to simply use this as a macro
(and not as a function)?

Robin said:
Why not do it as a UDF? You can then enter it in your sheet as a
function,
or use it as a macro as shown below.

Option Private Module
Option Explicit
Option Compare Text

Public Function ParseIndefinites(vValue As Variant) As Variant
Dim vIndefs As Variant
Dim vTest As Variant

vIndefs = Array("The ", "An ", "A ")
vValue = Trim(vValue)

For Each vTest In vIndefs

If InStr(vValue, vTest) = 1 Then

ParseIndefinites = Mid(vValue, Len(vTest) + 1) & ", " & vTest
Exit Function

End If

Next vTest
ParseIndefinites = vValue
End Function

Sub Parse()
Dim rngCell As Range
Dim rngTest As Range

For Each rngCell In Intersect(Sheets(1).Columns(1).EntireColumn,
Sheets(1).UsedRange).Cells
If Not IsEmpty(rngCell.Value) Then rngCell.Value =
ParseIndefinites(rngCell.Value)
Next rngCell
End Sub


Robin Hammond
www.enhanceddatasystems.com

"KHashmi316" <[email protected]>
wrote
in message
 
J

JMB

True, but Excel worksheet functions could also be used and they'd probably
run faster than either the macro or the UDF.

Assuming the data is in cell D3

=IF(ISERROR(MATCH(LEFT(TRIM(D3),SEARCH("
",TRIM(D3),1)-1),{"A","An","The"},0)),D3,RIGHT(TRIM(D3),LEN(D3)-SEARCH("
",TRIM(D3),1)))
 
J

JMB

you may have Option Explicit in your module (requiring variables to be
declared)
under the existing Dim statement add

Dim x as object
 
J

JMB

Also - if you use the macro - you should change the For Each line to

For Each x In Intersect(Selection, Selection.Parent.UsedRange)

that way - it doesn't waste time looping through cells that are not used
anyway.
 
K

KHashmi316

you may have Option Explicit in your module (requiring variables to be
declared)
under the existing Dim statement add

Dim x as object


...and also ditto for y, I assume (which I did). But now, I get the
following compile error ...

"For Each control variable on arrays must be a Variant"

...with 'y' highlighted in the follwoing line:

For Each y In Array1

So, I declared 'y' as a Variant. Next, I ran into a compile error due
to End If, per your orig code, so I removed "End If".

It runs, but ONLY removes leading "The", not "A" or 'An".

Here's the whole macro as of the latest edit:

Sub Test()

Dim x As Object
Dim y
Dim Array1()


On Error Resume Next
Array1 = Array("The", "A", "An", "a", "an", "the")

For Each x In Intersect(Selection, Selection.Parent.UsedRange)
x.Value = Trim(x.Value)
For Each y In Array1
If (UCase(Left(x.Value, InStr(1, x.Value, " ", vbTextCompare) - 1)) =
UCase(y)) _
And (InStr(1, x.Value, " ", vbTextCompare) - 1 > 0) Then x.Value =
Trim(Replace(x.Value, y, "", 1, 1, vbTextCompare))


Exit For


Next y
Next x


End Sub
 
Ad

Advertisements

K

keepITcool

no need for macros: you could do it with formulas.
copy down next to your list et voila..

SEARCH is very flexible since it accepts arrays.
Note it's case insensitive


=TRIM(
IF(
ISNA(MATCH(1,SEARCH({"The ";"A ";"An "},A1),0)),
A1,
MID(A1,LOOKUP(1,SEARCH({"The ";"A ";"An "},A1),{4;2;3})+1,9999)
)
)




--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


KHashmi316 wrote :
 
K

KHashmi316

keepITcool said:
no need for macros: you could do it with formulas.
copy down next to your list et voila..

No. Formulas are not useful in my particular situation for the very
reason ("copy down next to your list") you note.
 
L

Leith Ross

Hello KHashmi316,

Copy and Paste this macro code into a standard VBA Module. To use it
first select the cells or columns you want. Press ALT+F8 to bring u
the Macro List and select "RemoveArticles" and click RUN. To use thi
macro in code simply select the range first and call the macro.

MACRO CODE


Code
-------------------
Public Sub RemoveArticles()

Dim sLen As Integer
Dim iSpace As Integer
Dim Article As String
Dim TitleText As String

Dim C As Long
Dim R As Long

Dim StartCol As Long
Dim EndCol As Long
Dim StartRow As Long
Dim EndRow As Long

With Selection
StartCol = .Column
StartRow = .Row
EndCol = .Columns.Count - StartCol + 1
EndRow = .Rows.Count - StartRow + 1
End With

'Loop through the Selection
For C = StartCol To EndCol
For R = StartRow To EndRow
'Remove leading spaces from title
TitleText = LTrim(Cells(R, C).Value)
'Find the space that separates the first and second words
iSpace = InStr(1, TitleText, Chr$(vbKeySpace))
'Check if separating space is present
If iSpace > 0 Then
'Isolate the first word
Article = LCase(Left(TitleText, iSpace - 1))
'Check if it is an article
If Article = "a" Or Article = "an" Or Article = "the" Then
'Get length of Title
sLen = Len(TitleText)
'Save Title without the article or leading and trailing spaces
Cells(R, C).Value = Trim(Right(TitleText, sLen - iSpace))
End If
Else
'Remove any leading or trailing spaces in the Title
Cells(R, C).Value = Trim(TitleText)
End If
Next R
Next C

Cells(StartRow, StartCol).Activate

End Su
-------------------
 
K

KHashmi316

Leith said:
Copy and Paste this macro code into a standard VBA Module. To use it,
first select the cells or columns you want. Press ALT+F8 to bring up
the Macro List and select "RemoveArticles" and click RUN. To use this
macro in code simply select the range first and call the macro.

Hi, Leith:

I did as you instructed, but nothing happened. Unfortunately, I don't
know enough VBA to troubleshoot. If it helps, I'm using Excel 2002.

Thx for any further light you can shed.
 
L

Leith Ross

Hello KHashmi316,

I should have included this with code...

TO ADD A VBA MODULE:
1) Copy all the Macro Code by selecting it and then pressing *CTRL and
C*
2) Open the Workbook
3) Press *ALT and F11*, this opens the VBA Editor
4) Bring up the Insert Menu by pressin *ALT and I*
5) Insert a new Module into the Project by pressing the Letter *M*
6) Paste the code into the Module by pressing *CTRL and V*
7) Press *CTRL and S* to Save the Macro

Sincerely,
Leith Ross
 
Ad

Advertisements

A

anilsolipuram

Backup your original macro before trying my macro.

I am not sure if this is what you are looking for.


Sub macro()
Dim r As Range
Set r = Selection
For Each c In r
c.Value = Trim(c.Value)
t = Split(c.Value, " ")
If (UBound(t) > 0) Then
If (t(0) = "a" Or t(0) = "an" Or t(0) = "the") Then
c.Value = Trim(Mid(c.Value, Len(t(0)) + 1))
End If
End If
Next
End Sub
 
K

KHashmi316

Leith said:
Hello KHashmi316,

I should have included this with code...

TO ADD A VBA MODULE
1) Copy all the Macro Code by selecting it and then pressing *CTRL an
C*
2) Open the Workbook
3) Press *ALT and F11*, this opens the VBA Editor
4) Bring up the Insert Menu by pressin *ALT and I*
5) Insert a new Module into the Project by pressing the Letter *M*
6) Paste the code into the Module by pressing *CTRL and V*
7) Press *CTRL and S* to Save the Macro

Sincerely,
Leith Ross

Hi, Leith:

I do know the *basics* of creating macros, so I'm familiar with th
procedure. IOW, already did all of the above. As far as the cod
itself, I can't tell you why it's not working -- for me, anyway
 
L

Leith Ross

Hello KHashmi316,

Have you set your System Security level to medium? If it is set to High
the Macro won't run.

Sincerely,
Leith Ross
 
Ad

Advertisements

K

KHashmi316

anilsolipuram said:
Backup your original macro before trying my macro.

I am not sure if this is what you are looking for.


Sub macro()
Dim r As Range
Set r = Selection
For Each c In r
c.Value = Trim(c.Value)
t = Split(c.Value, " ")
If (UBound(t) > 0) Then
If (t(0) = "a" Or t(0) = "an" Or t(0) = "the") Then
c.Value = Trim(Mid(c.Value, Len(t(0)) + 1))
End If
End If
Next
End Sub

Hi, anilsolipuram:

Ran into compile error ("Variable not defined) on this line of code:

For Each c In
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top