PDA

View Full Version : Solved: Running a Function from a Worksheet


jdilts
06-22-2012, 06:54 AM
Hello,

We receive a text file as output and import it into Excel to be formatted. We are trying to automate the formatting, but I don't understand how to run my function from the spreadsheet. I can run it from the VBA editor by pressing F5, but I need to know how to do it from the worksheet. The idea is I am going to hand off this function to co-workers and I need to show them how to run it. Does a function require and argument to be passed to it? This is my 1st time writing a VBA. Any advice would be amazing. Thanks!

The function gets the size of the number of columns, from that number moves backwards to delete the empty columns. Then it iterates down each row, while it is in each row it checks the value of one of the columns and if it meets the requirements concatenates that to a stored location with a comma in between, etc..... (formatting)

Function FormatSpreadsheet()
Dim x As Integer
Dim RowPos As Integer
Dim ColPos As Integer
Dim i As Integer
Dim Last As Long
Dim j As Long
Dim LastRow As Long
Dim Las As Long
Dim k

'Finds the last column in the Range: gives column count
Last = Cells.Find("*", SearchOrder:=xlByColumns, _
LookIn:=xlValues, SearchDirection:=xlPrevious).Column
'MsgBox Last

'Deletes the empty columns in the Range
For j = Last To 5 Step -3
Columns(j).Delete
Next

'Find the last used row in column A: gives row count
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
'MsgBox LastRow

'Selects the 1st cell
Range("B2").Select
' Iterating DOWN the Rows
For x = 1 To LastRow
RowPos = ActiveCell.Row
ColPos = ActiveCell.Column
'MsgBox RowPos & "," & ColPos

i = x + 1
'Find the last used column in a Row: row 1 in this example
Dim LastCol As Integer
With ActiveSheet
LastCol = .Cells(i, .Columns.Count).End(xlToLeft).Column
End With
LastCol = (LastCol - 2) / 2
'MsgBox LastCol


' Iterating ACROSS a single Row
For y = 1 To LastCol
ActiveCell.Offset(0, 1).Select

Dim rPos
Dim cPos
Dim ErPos
Dim EcPos

'If the first Allele column in numeric and not X or Y
If Not IsNumeric(ActiveCell.Value) Then

Else
'stores the concatenation site
If y = 1 Then
rPos = ActiveCell.Row
cPos = ActiveCell.Column
End If

'store the sites 'to be' concatenated
If y <> 1 Then
ErPos = ActiveCell.Row
EcPos = ActiveCell.Column
End If


'move to the height column
ActiveCell.Offset(0, 1).Select
Height = ActiveCell.Value

If Not IsNumeric(ActiveCell.Value) Then
'MsgBox "not numeric" | do nothing
End If

'if it is the 1st height and it is under 100 then clear the cell's contents else do nothing
If y = 1 And Height < 50 Then
Cells(rPos, cPos).ClearContents
End If

If y = 1 And Height > 50 And Height < 99 Then
Cells(rPos, cPos).Font.Color = &HC0C0C0
End If

'if is not the 1st height and it is equal to or greater than 100, concatenate allele current site to the 'base' allele site
If y <> 1 And Height >= 100 Then
'concatenate allele to cells(rPos, cPos)
Cells(rPos, cPos) = Cells(rPos, cPos) & "," & Cells(ErPos, EcPos)
End If

End If

Next

Cells(RowPos, ColPos).Select
' Selects cell down 1 row from active cell.
ActiveCell.Offset(1, 0).Select
Next


'Finds the last column in the Range: gives column count
Las = Cells.Find("*", SearchOrder:=xlByColumns, _
LookIn:=xlValues, SearchDirection:=xlPrevious).Column
'MsgBox Last
'Deletes the left over columns
For k = 4 To Las
Columns(4).Delete
Next



End Function
Kenneth Hobs
06-22-2012, 08:26 AM
Welcome to the forum!

A public function in a Module can be played by Alt+F8. You could add an ActiveX button from Insert in the Developer ribbon. Another method is to add a button on the ribbon. The user could play it from the Developer ribbon as well. You could Insert a Shape and Assign a macro to it. So, lots of ways to do it.
Aussiebear
06-22-2012, 07:31 PM
Any reason why this wouldn't work?

Sub FormatSpreadsheet()
Dim x As Integer
Dim RowPos As Integer
Dim ColPos As Integer
Dim i As Integer
Dim Last As Long
Dim j As Long
Dim LastRow As Long
Dim Las As Long
Dim k

'Finds the last column in the Range: gives column count
Last = Cells.Find("*", SearchOrder:=xlByColumns, LookIn:=xlValues, _
SearchDirection:=xlPrevious).Column
'MsgBox Last
'Deletes the empty columns in the Range
For j = Last To 5 Step -3
Columns(j).Delete
Next
'Find the last used row in column A: gives row count
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
'MsgBox LastRow
'Selects the 1st cell
Range("B2").Select
' Iterating DOWN the Rows
For x = 1 To LastRow
RowPos = ActiveCell.Row
ColPos = ActiveCell.Column
'MsgBox RowPos & "," & ColPos
i = x + 1
'Find the last used column in a Row: row 1 in this example
Dim LastCol As Integer
With ActiveSheet
LastCol = .Cells(i, .Columns.Count).End(xlToLeft).Column
End With
LastCol = (LastCol - 2) / 2
'MsgBox LastCol
' Iterating ACROSS a single Row
For y = 1 To LastCol
ActiveCell.Offset(0, 1).Select

Dim rPos
Dim cPos
Dim ErPos
Dim EcPos

'If the first Allele column in numeric and not X or Y
If Not IsNumeric(ActiveCell.Value) Then
Else
'stores the concatenation site
If y = 1 Then
rPos = ActiveCell.Row
cPos = ActiveCell.Column
End If
'store the sites 'to be' concatenated
If y <> 1 Then
ErPos = ActiveCell.Row
EcPos = ActiveCell.Column
End If
'move to the height column
ActiveCell.Offset(0, 1).Select
Height = ActiveCell.Value
If Not IsNumeric(ActiveCell.Value) Then
'MsgBox "not numeric" | do nothing
End If
'if it is the 1st height and it is under 100 then clear the cell's contents else do nothing
If y = 1 And Height < 50 Then
Cells(rPos, cPos).ClearContents
End If
If y = 1 And Height > 50 And Height < 99 Then
Cells(rPos, cPos).Font.Color = &HC0C0C0
End If
'if is not the 1st height and it is equal to or greater than 100, concatenate allele current site to the 'base' allele site
If y <> 1 And Height >= 100 Then
'concatenate allele to cells(rPos, cPos)
Cells(rPos, cPos) = Cells(rPos, cPos) & "," & Cells(ErPos, EcPos)
End If
End If
Next
Cells(RowPos, ColPos).Select
' Selects cell down 1 row from active cell.
ActiveCell.Offset(1, 0).Select
Next
'Finds the last column in the Range: gives column count
Las = Cells.Find("*", SearchOrder:=xlByColumns, _
LookIn:=xlValues, SearchDirection:=xlPrevious).Column
'MsgBox Last
'Deletes the left over columns
For k = 4 To Las
Columns(4).Delete
Next
End Sub
jdilts
06-25-2012, 06:52 AM
Hi Aussiebear,

I'm super new to VB. If I made it a sub....how would I then run the sub from the spreadsheet? I feel like I need to have it as a function to load into excel. Since I'm passing off to co-workers who just want to be able to click a button.
jdilts
06-25-2012, 06:57 AM
Hi Kenneth Hobs,

How do I load it as a macro? or add a button on the ribbon? Or could you point me to a tutorial on how to do so? I need to have it as permanent function in excel, so they don't have to keep loading it every time Excel is opened. I've looked through rondebruin.nl/personal.htm, but I can't find the personal.xls file on windows7. Is it hidden?
jdilts
06-25-2012, 07:59 AM
Hi Kenneth Hobs,

I found the XLStart directory on windows7, but nothing is in it (no personal.xls).
Kenneth Hobs
06-25-2012, 08:02 AM
The easiest way to create a Personal.xls or Personal.xlsb is to record a macro and save it. Once saved, in the Immediate window of the VBE to see the path, type the code below and press the Enter key:
?Workbooks("Personal.xls").Path

Normally, you would probably not run a macro from the Personal workbook. If you want to run a workbook macro from another, Application.Run is the method to use.

For running a macro, look at this MVP's site: http://dmcritchie.mvps.org/excel/getstarted.htm
jdilts
06-25-2012, 09:34 AM
Solved! http://www.rondebruin.nl/personal.htm works great! Thanks for your replies.