Rename PDF's files pseudo-automatically with MsWord

As an engineer, many times I have to download scientific papers from internet, when I do this, the best thing would be that the download file would have a name like:

John Doe - The Importance of Scientific PDFs for Engineers.pdf

or, at least:

jdoe-scientificpdfsengineers.pdf

you know, something to make easy the desktop search afterwards, when you have a folder with maybe hundreds of papers. Instead, the name you get is:

018293857362394932.pdf
or: jd-ispe.pdf

and you don't have time to rewrite, or copy-past the author and title, because it comes with those annoying line breaks that pdf files have (plus asterisks,crosses, etc).
On the other hand, maybe the properties of the pdf come with the proper author and title, but many times this is not the case.

So I made up this simple macro for MsWord. I know it's not an optimal solution. But it gives good results in principle. Maybe I'll add some more features later, but for now this is somewhat helpful.

One example:
The article
The Effect of Age of Cochlear Implantation on Language
Growth in Infants and Toddlers
by
J. Bruce Tomblin, Linda Spencer, & Brittan Barker

Can be downloaded from here

And if you download it like that, the name will be "age-ci.pdf" (not very meaningful, right?)

Now, using this macro, in 3 steps you could have a name like:

"The Effect of Age of Cochlear Implantation on Language Growth in Infants and Toddlers J. Bruce Tomblin, Linda Spencer, Brittan Barker.pdf"

Which, at least to me, seams a LOT more meaningful and easy to find.

Sub CorrPDFtext()
'
' CorrPDFtext Macro
' Erases undesired characters from pdf pieces of text, in order to rename more easily a
' scientific paper
' Actually, it can be used to many other things, it is an automatic way of replacing large
' amounts of text, you just have to modify it a little
' Copyright Andres Mauricio Gonzalez Vargas, 2012

'-Instructions:
'First, you should open the pdf you are downloading on your browser
'Second, select manually the title and the name of the authors, altogether
'Third, Copy the selection and go to msword.
'Then you can call the "CorrPDFtext" sub
'-----------------

'The sub starts pasting what you have in the clipboard, (title and author, suposedly)
Selection.Paste
Selection.WholeStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

'Here I call the Sub "DoReplace" given a lower and an upper limit,
'based on the ASCII code of the characters
DoReplace 0, 31 'ASCII control characters (character code 0-31)
'ASCII 32 is " " space
DoReplace 33, 43 'ASCII printable characters that are not letters
'DoReplace 41, 42 'ASCII printable characters that are not letters
'ASCII 44 is "," comma
'ASCII 45 is "-" hyphen
'ASCII 46 is "." period
DoReplace 47, 64 'ASCII printable characters that are not letters
DoReplace 91, 96 'ASCII printable characters that are not letters
DoReplace 123, 191 'ASCII printable characters (some letters with accents, actually could be useful)
'ASCII 192-255 are mostly letters with acute,tilde,dieresis, etc.

'The following is to get rid of multiple spaces left by the replacement process
For i = 1 To 3
With Selection.Find
.Text = " "
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindStop 'This is to avoid the confirmation message box
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Next i

'---------------------
'And finally cut everything and sent to clipboard, so you can paste it in the "save as" dialog
Selection.WholeStory
Selection.Cut
End Sub

Sub DoReplace(loLim As Double, upLim As Double)
'This sub is intended to replace the characters given by the upper and lower limits

For i = loLim To upLim
With Selection.Find
.Text = Chr(i) 'the text to be replaced is given by the current ASCII code
.Replacement.Text = " " 'The replacement string is an space, it could be empty,
'but I prefer not to, in order to not join separate words
.Forward = True
.Wrap = wdFindStop 'This way you avoid the confirmation window
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

Next i


End Sub

'---------And that's it!

Merging Multiple Cells into Single One in Excel

These are very simple and useful macros to concatenate the content of multiple cells, merging it into one cell.

'Macros for Horizontal and Vertical concatenation

'Copyright, Andrés Gonzalez, 2008

Sub mezclar() 'horizontal concatenation

For Each fila In Selection.Rows

mensaje = ""

For Each celda In fila.Cells

mensaje = mensaje & celda.Value & " "

Next

fila.Clear

fila.Cells(1, 1).Value = mensaje

Next

End Sub

Sub mezclarV() 'vertical concatenation

For Each columna In Selection.Columns

mensaje = ""

For Each celda In columna.Cells

mensaje = mensaje & "- " & celda.Value & Chr(10)

Next

columna.Clear

columna.Cells(1, 1).Value = mensaje

Next

End Sub

Let's say you have the following table:

Albert	Einstein
Nikola	Tesla

With the first macro the result will be:

albert einstein

nikola tesla

And with the second, it will be:

- albert - nikola

- einstein - tesla

I think this one is cool, isn't it?

Lower-case Upper-case Macros on Excel

These are to simple macros to convert cells between uppercase and lowercase. I know it's very easy in Word... but I haven't found that damn button on Excel...

'This two macros replace the strings in a range to their

'equivalent in upper-case or lower-case

'Copyright, Andrés Gonzalez, 2008

Sub MINUSMAYUS()

For Each celda In Selection

celda.Value = StrConv(celda.Value, vbUpperCase)

Next

End Sub

Sub MAYUSMINUS()

For Each celda In Selection

celda.Value = StrConv(celda.Value, vbLowerCase)

Next

End Sub

Find a File's Modification Date in Excel

'This function gives the date of last modification of a given file

'example: fecharchivo("c:\testfile.txt")

' result: "15/12/2011 07:35:29 p.m."

'Copyright, Andrés González, 2008

Function fecharchivo(abrir As String) As Variant

Dim fs, f, s

Set fs = CreateObject("Scripting.FileSystemObject")

Set f = fs.GetFile(abrir)

fecharchivo = f.DateLastModified

fecharchivo = Format(fecharchivo, "General Date")

End Function

Count Unique Values in a Range of Cells

I'm not sure why I wrote this function... I'm sure there are easier and more useful ways to do this... but at the time I remember it accomplished its mission so, for what it's worth...

'This macro counts the number of unique values in a range and

'displays a message with the result

'Copyright, Andrés González, 2008

Sub contarunicos()

Dim matriz()

SizeRango = Selection.Count

ReDim matriz(SizeRango)

'matriz(pos) = rango(pos, 1)

ocurrencia = 0

celdas = 0

ultima = 1

For Each celda In Selection

For cont = 1 To ultima

If celda.Value = matriz(cont) Then

ocurrencia = "si"

Else

garbage = 1

End If

Next cont

If ocurrencia = "si" Then

ultima = ultima

Else

matriz(ultima) = celda.Value

ultima = ultima + 1

End If

ocurrencia = 0

Next

MsgBox ("There are " & ultima - 1 & " unique values")

End Sub

Replace Error Message with Custom Message in Excel

Another simple function... there are other ways to do it, but this one seems faster to me

'This function takes away errors in formulas and replace them for something

'more meaningful (a string defined by the user)

'example: quitarerror(1/0;"you can't divide by zero")

' result:"you can't divide by zero"

'Copyright, Andrés González, 2008

Function quitarerror(dato As Variant, reemplazo As Variant) As Variant

If IsError(dato) = True Then

quitarerror = reemplazo

Else

quitarerror = dato

End If

End Function

Extracting Substrings from Strings on Excel (III)

'This function extracts a substring from

'a bigger string, using a smaller string as "separator" and

'defining which one of the remaining substrings to take

'example: EXTRAERPARTE("this is a long string";1;" ")

' result: "this"

' EXTRAERPARTE("this is a long string";4;" ")

' result: "long"

'It can be very useful to separate long sentences into single words,

'by pointing the desired part to an array of sequential numbers

'%Copyright, 2008, Andrés González

Function EXTRAERPARTE(texto As String, queParte As Integer, separador As String) As String

Dim cont

numPartes = 0

partes = Split(texto, separador)

For Each parte In partes

numPartes = numPartes + 1

Next

If (queParte <= numPartes) Then

EXTRAERPARTE = partes(queParte - 1)

Else

EXTRAERPARTE = ""

End If

End Function

Extracting Substrings from Strings on Excel (II)

'This function extracts a substring from

'a bigger string, using a smaller string as "key" and

'defining two more "key characters" as delimiters on the left and

'the right sides of the string

'example: exizderT("givemeyourKEYsplease";"KEY";"m";"e")

' result:"eyourKEYspl"

'%Copyright, 2008, Andrés González

Function exizderT(texto As String, clave As String, cizquierda As String, cderecha As String) As String

inicio = InStr(1, texto, clave, 1)

izquierda = InStrRev(texto, cizquierda, inicio, 1)

If izquierda = 0 Then

izquierda = 1

Else

izquierda = izquierda + 1

End If

If inicio + Len(clave) >= Len(texto) Then

derecha = Len(texto) + 1

Else

derecha = InStr(inicio + Len(clave), texto, cderecha, 1)

End If

If derecha = 0 Then

derecha = Len(texto) + 1

End If

extraccion = Mid(texto, izquierda, derecha - izquierda)

exizderT = extraccion

End Function

Extracting Substrings from Strings on Excel (I)

Well... it does exactly what the comment says:

'This function extracts a substring from

'a bigger string, using a smaller string as "key" and

'defining a number of characters to the left and

'to the right of the key string

'example: exizderN("givemeyourKEYsplease";"KEY";2;3)

' result: "urKEYspl"

'%Copyright, 2008, Andrés González

Function exizderN(texto As String, clave As String, izquierda As Integer, derecha As Integer) As String

inicio = InStr(1, texto, clave, 1)

extraccion = Mid(texto, inicio - izquierda, izquierda + Len(clave) + derecha)

exizderN = extraccion

End Function

Extracting Numbers from Strings on Excel

Here I'll start to share some functions that I developed for Visual Basic on Excel some years ago. They all include explanatory comments in english, but the names of variables are in spanish.

This function delivers a number as double, but it can be easily modified to take it as string just erasing the last line and changing the function type to Double.

'This function extracts a numerical string from

'another string that may contain other characters

'it only extract the FIRST numerical string

'obviously, it can be pointed to a cell that contains text

'example: EXTRAERNUM("sampletext853first")=853

'example: EXTRAERNUM("sample16text853first")=16

'%Copyright, 2007, Andrés González

Function EXTRAERNUM(texto As String) As Double

Dim buscando, caracter, posCar, inicioNumero, finalNumero

buscando = "primera"

For posCar = 1 To Len(texto)

caracter = Mid(texto, posCar, 1)

If (IsNumeric(caracter) = True And buscando = "primera") Then

inicioNumero = posCar

finalNumero = posCar

buscando = "ultima"

ElseIf (IsNumeric(caracter) = True And buscando = "ultima") Then

finalNumero = posCar

ElseIf (IsNumeric(caracter) = False And buscando = "ultima") Then

buscando = "nada"

End If

Next posCar

EXTRAERNUM = Mid(texto, inicioNumero, finalNumero - inicioNumero + 1)

EXTRAERNUM = Val(EXTRAERNUM)

End Function