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