Allowing the user to pick a cell in excel

Hi,

I would like to allow the user of my program to choose which cell that should be the starting cell for my program. How can I do this with a macro.

This is how the code should work:

It searches the worksheet for a specific text-string(This part have I fixed). If it fails to find that cell I want a pop up window to be visible where the user is asked to point out which cell that should be used as starting cell. The, by the user selected cell address should then be assign to a variable inside the code.

Anyone that knows how to do this?

\Jonas

[585 byte] By [Jonas.S] at [2007-12-25]
# 1

Hi Jonas,

Yes there is a rather smart way of doing this using the input box here's an example.

'selects the cell and returns the value of that cell
Dim myRange As Range
Set myRange = Application.InputBox(prompt:="Select the cell containing the data you want.", Type:=8)
If Not myRange Is Nothing Then
'cancel pressed
End If

DerekSmyth at 2007-8-31 > top of Msdn Tech,Microsoft ISV Community Center Forums,Visual Basic for Applications (VBA)...
# 2

Thanks Derek!

It solved one of my issues. However one is left and that is. I would need to find which row and column the picked cell is located in as in the example below, see red colored.

ActiveSheet.Select
Range("A1:U1000").Select
y = Selection

Dim row_disp, column_disp

For j = column To column + 1
For i = row To size_row
w = y(i, j)
If w = "Displ. [mm]" Then row_disp = i
If w = "Displ. [mm]" Then column_disp = j
If w = "Displ. [mm]" Then GoTo End_loop1
Next i
Next j
End_loop1:

Do you know how I can get this data from myRange in your reply?

Thankful for help

\Jonas

Jonas.S at 2007-8-31 > top of Msdn Tech,Microsoft ISV Community Center Forums,Visual Basic for Applications (VBA)...
# 3

Hi, I think giving you my utility file is more helpful. I am kind of too lazy to look into the whole thing. Basically this utility file give you all the example of some useful stuff.

The first is called Utility class, second called Utility_Move class. Hope this clear most of stuff you are not sure of.

' ======================== For Starter ========================
' For starter who is not experenced with Excel VBA, please read.
' You need to know the basics of VBA. Here is the list of things you should know.

' Hints.
' Use Record if you don't know what function you can use to do certain operations
' that you can do manually.

' Last Resort.
' Application.SendKeys will explicitly send key strokes.
' Application.SendKeys "+abc{Enter}" means, typing Abc and Enter.
' Sample: Better to follow this, or you will have problems.
' With ThisWorkbook.Worksheets("Sheet1")
' .Activate
' .Cells(1, 1).Select
' SendKeys "{F2}TEST~", True
' .Cells(1, 1).Copy
' .Cells(2, 2).PasteSpecial Paste:=xlPasteValues
' End With
' MsgBox "macro1"

' Range Objects.
' ActiveCell, CurrentRegion, Cells(), Range(), Selection are Range objects, but ActiveCell only contains one address
' Range("A1").select will select the first cell
' Range("A1:C1, E1").select will select Cells from A1 to C1, and E1 separately.
' Cells.Select will select everything in the sheet
' Cells(5, 2).select will select "B5"
' Cells(5, "B").select will select "B5"
' ActiveCell.CurrentRegion.select will select the whole area current cell located in.

' Cell Info.
' Use ActiveCell.FormulaR1C1 to get the formula.
' Use ActiveCell.Value to get value of formated formula. When copy value, format is copied as well.
' Use 123<=>ABC Converter when you want to convert ActiveCell.Column to ABC format, and vice versa.

' ======================== For Everyone ========================
' You need to include References: Microsoft Scripting Runtime
' This is because Scripting.FileSystemObject is included for easier access.
' You must include Utility_Move along with this code object.
' Also public member Go will provide you with Utility_Move functionalities.
' Please refer those functionalities to Utility_Move class.
' Function name should be self-explainatory.
' Play around it to see how they work.
Option Explicit

Public fso As Scripting.FileSystemObject
Public Go As Utility_Move

Dim Column(26) As String
Dim i As Long
Private Sub Class_Initialize()
Set fso = New Scripting.FileSystemObject
Set Go = New Utility_Move

For i = 0 To 25
Column(i) = Chr(i + 65)
Next
End Sub

' ============================= 123<=>ABC Converter ============================
Function ABCToNumber(columnString As String) As Long
Dim length As Long, result As Long
Dim characterIndex As Long
length = Len(columnString)
result = 0
Dim i
For i = 1 To length
' index one character
characterIndex = Asc(Mid(columnString, length - i + 1, 1)) - 64
' convert to the index of current digit
characterIndex = characterIndex * (26 ^ (i - 1))
' commit to result
result = result + characterIndex
Next
ABCToNumber = result
End Function

Function NumberToABC(columnLong As Long) As String
Dim reminder As Long, result As String
result = ""
Do Until columnLong / 26 < 1
reminder = columnLong Mod 26
result = Column(reminder - 1) + result
columnLong = columnLong / 26
Loop
reminder = columnLong Mod 26
result = Column(reminder - 1) + result
NumberToABC = result
End Function

' =============================String Token============================
' chr(34) = "
Function Peek(text As String, Optional stopBy As String = ",", Optional delimiter As String = "chr(34)") As String
Dim tempText As String
tempText = Left(text, Len(text))
Peek = NextToken(tempText, stopBy, delimiter)
End Function

Function NextToken(ByRef text As String, Optional stopBy As String = ",", Optional delimiter As String = "chr(34)") As String
If delimiter = "chr(34)" Then delimiter = Chr(34)

Dim skipStopBy As Boolean
skipStopBy = False
NextToken = ""
Do Until Left(text, Len(stopBy)) = stopBy And Not skipStopBy
If Left(text, Len(delimiter)) = delimiter Then
If skipStopBy = True Then
skipStopBy = False
Else
skipStopBy = True
End If
End If

If Left(text, Len(stopBy)) = stopBy Then
NextToken = NextToken + Left(text, Len(stopBy))
text = Right(text, Len(text) - Len(stopBy))
Else
NextToken = NextToken + Left(text, 1)
text = Right(text, Len(text) - 1)
End If

If Len(text) < 1 Then GoTo Final_Step
Loop
text = Right(text, Len(text) - 1)
Final_Step:
If Left(NextToken, 1) = delimiter And Right(NextToken, 1) = delimiter Then NextToken = Mid(NextToken, 2, Len(NextToken) - 2)
End Function

Function PeekFixedWidth(text As String, width As Long) As String
PeekFixedWidth = Left(text, width)
End Function

Function NextTokenFixedWidth(ByRef text As String, width As Long) As String
NextTokenFixedWidth = PeekFixedWidth(text, width)
text = Right(text, Len(text) - width)
End Function

' =============================Selection============================
' This is obsolete because RegionPoints provide much more flexibility.
Sub SelectRegion(Optional Column As Integer = 0, Optional Row As Integer = 0, Optional Position As String = "A1")
Dim tbl
Set tbl = Range(Position).CurrentRegion
If (Column > 0) Then Set tbl = tbl.Offset(0, Column).Resize(tbl.Rows.Count, tbl.Columns.Count - Column + 1)
If (Row > 0) Then Set tbl = tbl.Offset(Row, 0).Resize(tbl.Rows.Count - Row + 1, tbl.Columns.Count)
tbl.Select
End Sub

' After Obtain region points, you can select the cell and move them around to the desire position.
' Then, simply use Range(cellAddress1 +":"+ cellAddrees2).select to select desired area.
Sub RegionPoints(ByRef TopLeft_Row As Long, ByRef TopLeft_Column As Long, _
ByRef BottomRight_Row As Long, ByRef BottomRight_Column As Long, Optional Position As String)
Dim tbl As Range
If Position = "" Then
Set tbl = Range(CellAddress).CurrentRegion
Else
Set tbl = Range(Position).CurrentRegion
End If
Dim address As String, allAddress As String
allAddress = tbl.address

If allAddress <> "" Then
address = NextToken(allAddress, ":")
TopLeft_Row = CLng(CellRow(address))
TopLeft_Column = ABCToNumber(CellColumn(address))
Else
TopLeft_Row = 0
TopLeft_Column = 0
End If

If allAddress <> "" Then
address = NextToken(allAddress, ":")
BottomRight_Row = CLng(CellRow(address))
BottomRight_Column = ABCToNumber(CellColumn(address))
Else
BottomRight_Row = TopLeft_Row
BottomRight_Column = TopLeft_Column
End If
End Sub

' This will find the boundary of the whole data sheet.
' Meaning boundary is combination of all regions, not just one region.
Sub DocumentPoints(ByRef TopLeft_Row As Long, ByRef TopLeft_Column As Long, _
ByRef BottomRight_Row As Long, ByRef BottomRight_Column As Long)
Dim Temp As Range
Set Temp = ActiveCell
FirstRowCell
TopLeft_Row = ActiveCell.Row
FirstColumnCell
TopLeft_Column = ActiveCell.Column
LastRowCell
BottomRight_Row = ActiveCell.Row
LastColumnCell
BottomRight_Column = ActiveCell.Column
Temp.Select
End Sub

Sub FirstRowCell()
Cells.Find(What:="*", After:=Cells(Rows.Count, Columns.Count), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
End Sub
Sub FirstColumnCell()
Cells.Find(What:="*", After:=Cells(Rows.Count, Columns.Count), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
End Sub
Sub LastRowCell()
Cells.Find(What:="*", After:=Cells(Rows.Count, Columns.Count), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False _
, SearchFormat:=False).Activate
End Sub
Sub LastColumnCell()
Cells.Find(What:="*", After:=Cells(Rows.Count, Columns.Count), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False _
, SearchFormat:=False).Activate
End Sub


' will not function correctly if the currently selection
' does not have more items to the direction
Function SelectTo(Direction As emMove, Optional times As Long = 1, Optional SkipHidden As Boolean = False) As Boolean
Dim address As String
address = CellAddress
SelectTo = Go.Move(Direction, Steps:=times, SkipHidden:=SkipHidden)
Range(address, Selection).Select
Range(address).Activate
End Function

' =============================Cell Info============================
' Use ActiveCell.Address if parameter is not present
Function CellColumn(Optional UnparsedAddress As String) As String
Dim Temp
If UnparsedAddress = "" Then
Temp = Split(ActiveCell.address, "$", -1, vbBinaryCompare)
Else
Temp = Split(UnparsedAddress, "$", -1, vbBinaryCompare)
End If
CellColumn = Temp(1)
End Function
Function CellRow(Optional UnparsedAddress As String) As String
Dim Temp
If UnparsedAddress = "" Then
Temp = Split(ActiveCell.address, "$", -1, vbBinaryCompare)
Else
Temp = Split(UnparsedAddress, "$", -1, vbBinaryCompare)
End If
CellRow = Temp(2)
End Function
Function CellAddress(Optional UnparsedAddress As String) As String
CellAddress = CellColumn(UnparsedAddress) + CellRow(UnparsedAddress)
End Function

'File Name and Folder Name related to current cell
Function CellFileRoot() As String
CellFileRoot = Left(ActiveWorkbook.FullName, Len(ActiveWorkbook.FullName) - Len(ActiveWorkbook.name) - 1)
End Function
Function CellFileName() As String
CellFileName = ActiveWorkbook.name
End Function

' Spaces in the cell count treated as Empty
Function CellIsEmpty() As Boolean
CellIsEmpty = (Trim(ActiveCell.FormulaR1C1) = "")
End Function
Function RowIsEmpty() As Boolean
Dim addr As String
addr = CellAddress
Range("A" + CellRow).Select
RowIsEmpty = Not (Go.RightMost)
Range(addr).Select
End Function
Function ColumnIsEmpty() As Boolean
Dim addr As String
addr = CellAddress
Range(CellColumn + "1").Select
ColumnIsEmpty = Not (Go.UpMost)
Range(addr).Select
End Function
Function SheetIsEmpty(Optional SpaceAsEmpty As Boolean = True) As Boolean
If SpaceAsEmpty Then
Dim addr As String
addr = CellAddress
SheetIsEmpty = Not Find("*")
Do Until SheetIsEmpty = True Or addr = CellAddress
If Trim(ActiveCell.FormulaR1C1) <> "" Then SheetIsEmpty = False: Exit Function
SheetIsEmpty = Not Find("*")
Loop
SheetIsEmpty = True
Else
SheetIsEmpty = Not Find("*")
End If
End Function

' Font Operation
' No Para = Get. Has Para = Set.
Function Color(Optional colorIndex As Integer) As Integer
If colorIndex = 0 Then
Color = Selection.Font.colorIndex
Else
Selection.Font.colorIndex = colorIndex
Color = colorIndex
End If
End Function

' =============================Range Op============================
Sub RangeCopy(srcSheet As String, srcTopCell As String, _
destSheet As String, destTopCell As String)
Sheets(srcSheet).Range(srcTopCell).Select
If Not SelectTo(eDownMost) Then
Sheets(destSheet).Range(destTopCell).Select
Else
Selection.Copy Sheets(destSheet).Range(destTopCell)
End If
End Sub
Sub RangeSum(Optional HeaderAtLeft As String = "Total", Optional colorIndex As Integer = 4)
Go.DownMost
Go.Down
If ActiveCell.Row = 2 Then
ActiveCell.FormulaR1C1 = ""
Else
Dim Temp As Integer
Temp = ActiveCell.Row - 2
ActiveCell.FormulaR1C1 = "=SUM(R[-" + CStr(Temp) + "]C:R[-1]C)"
End If

If HeaderAtLeft <> "" Then
If Go.Left Then
ActiveCell.FormulaR1C1 = "Total"
Selection.Font.colorIndex = colorIndex
End If
End If
End Sub
Sub RangeCopySum(srcSheet As String, srcCol As String, _
destSheet As String, destCol As String, _
Optional HeaderAtLeft As String = "Total", Optional colorIndex As Integer = 4)
RangeCopy srcSheet, srcCol, destSheet, destCol
RangeSum HeaderAtLeft, colorIndex
End Sub

' =============================Search============================
' Take Out vSearchFormat for older Excel.
Function Find(vWhat As String, Optional vAfter As String = "A1", _
Optional vLookInFormulas As Boolean = True, _
Optional vByPart As Boolean = True, Optional vByRows As Boolean = True, _
Optional vMatchCase As Boolean = False, Optional vSearchFormat As Boolean = False) As Boolean
Range(vAfter).Select
Dim vLookInFormulas2, vByPart2, vByRows2
If vLookInFormulas Then
vLookInFormulas2 = xlFormulas
Else
vLookInFormulas2 = xlValues
End If

If vByPart Then
vByPart2 = xlPart
Else
vByPart2 = xlWhole
End If

If vByRows Then
vByRows2 = xlByRows
Else
vByRows2 = xlByColumns
End If

On Error GoTo FindByRow_Error_Handle
Cells.Find(What:=vWhat, After:=ActiveCell, LookIn:=vLookInFormulas2, _
LookAt:=vByPart2, SearchOrder:=vByRows2, SearchDirection:=xlNext, _
MatchCase:=vMatchCase).Activate
'MatchCase:=vMatchCase, SearchFormat:=vSearchFormat).Activate

Find = True
Exit Function
FindByRow_Error_Handle:
Find = False
End Function

' =============================Other============================
Sub FreshSheet(name As String)
Dim oldAlerts
oldAlerts = Application.DisplayAlerts

On Error Resume Next
Sheets(1).Select
Application.DisplayAlerts = False
Sheets(name).Delete
Sheets.Add
ActiveSheet.name = name
Range("A1").Select
Application.DisplayAlerts = oldAlerts
On Error GoTo 0
End Sub

Sub DisableFilter(identifier As Variant)
Sheets(identifier).Range("A1").Select
Application.CutCopyMode = False
ActiveSheet.AutoFilterMode = False
End Sub

Sub EnableFilter(identifier As Variant)
DisableFilter identifier
Selection.AutoFilter
End Sub

Sub MoveAndText(Direction As emMove, text As String)
Go.Move Direction
ActiveCell.FormulaR1C1 = text
End Sub
Sub TextAndMove(Direction As emMove, text As String)
ActiveCell.FormulaR1C1 = text
Go.Move Direction
End Sub

' Works With Excel (xls), Tab Delimited (txt), and Comma Demilited (csv).
' Haven't try it with other files, but no need also.
Sub GetDataFromFile(SourceFolder As String, SourceFile As String, DestSheetName As String)
Dim thisBook As String
thisBook = ActiveWorkbook.name

FreshSheet DestSheetName
Workbooks.Open fileName:=SourceFolder + "\" + SourceFile
Workbooks(SourceFile).ActiveSheet.Cells.Copy Workbooks(thisBook).Sheets(DestSheetName).Range("A1")
Workbooks(SourceFile).Close False
Workbooks(thisBook).Sheets(DestSheetName).Select
End Sub

' The current active window Will be closed
Sub GetDataActiveWindow(DestSheetName As String)
Dim thisBook As String, thisSheet As String
thisBook = ActiveWorkbook.name
thisSheet = ActiveSheet.name

Windows(ThisWorkbook.name).Activate
FreshSheet DestSheetName
Workbooks(thisBook).Sheets(thisSheet).Cells.Copy Workbooks(ThisWorkbook.name).Sheets(DestSheetName).Range("A1")
Workbooks(thisBook).Close False
Workbooks(ThisWorkbook.name).Sheets(DestSheetName).Select
End Sub

' Take out un-visible items
Function SheetTrim(Optional SheetName As String, Optional overwriteOriginal As Boolean = False) As String
If SheetName = "" Then SheetName = ActiveSheet.name
Dim oldAlerts, extraPhrase
oldAlerts = Application.DisplayAlerts
extraPhrase = "_afterTrim"

FreshSheet SheetName + extraPhrase
Sheets(SheetName).Range("A1").CurrentRegion.Copy Sheets(SheetName + extraPhrase).Range("A1")

If overwriteOriginal Then
On Error Resume Next
Application.DisplayAlerts = False
Sheets(SheetName).Delete
Application.DisplayAlerts = oldAlerts
On Error GoTo 0
Sheets(SheetName + extraPhrase).Select
ActiveSheet.name = SheetName
SheetTrim = SheetName
Else
SheetTrim = SheetName + extraPhrase
End If
End Function

' Close the workbook without saving. Close Application if no more workbooks in the application.
' Use ActiveWorkbook if no book name supplied.
Sub CloseWorkBook(Optional book As String)
If book = "" Then book = ActiveWorkbook.name
On Error GoTo Failed
Workbooks(book).Saved = True
On Error GoTo 0

If Application.Workbooks.Count < 2 Then
Application.Quit
Else
Workbooks(book).Close
End If
Exit Sub
Failed:
End Sub

'Motive: Sometimes it is eaiser to debug when you use ActiveCell as current data record or parameter.
' When the macro stopped by exception or stop sign, you can determine the running progress by ActiveCell.
' And it is easier to say Up(5) instead of offset the row index, for me at least.

'Summary: The Utility_Move class introduce 3 sets of functions.
'First set, Up-Down-Right-Left simulate the key stroke of arrow keys.
' Additionally, Steps parameter allows you to repeat number of seps to that direction.
' Negative steps also means that you are stepping backward.
' The SkipHidden parameter skips hidden cells. When true, it acts like arrow keys that
' skips hidden rows by filter. When false, it will not skip hidden rows and select hidden cells.
'Second set, UpEnd-DownEnd-RightEnd-LeftEnd simulate arrow keys pressed after the End key.
' It offers same parameters as the first set, and behave the same.
'Third set, UpMost-DownMost-RightMost-LeftMost will locate the
' very last non-empty cell in that direction. Spaces are treated as non-empty cell.
' Features SkipHidden feature, when true, only select the visible last cell.

'Option Explicit
Public Enum emMove
eUp = -1
eDown = 1
eLeft = -2
eRight = 2

eUpEnd = -4
eDownEnd = 4
eLeftEnd = -8
eRightEnd = 8

eUpMost = -16
eDownMost = 16
eLeftMost = -32
eRightMost = 32
End Enum

' =============================Move Cell============================
Function Move(Direction As emMove, Optional Steps As Long = 1, Optional SkipHidden As Boolean = False) As Boolean
Select Case Direction
Case emMove.eUp
Move = Up(Steps, SkipHidden)
Case emMove.eDown
Move = Down(Steps, SkipHidden)
Case emMove.eRight
Move = Right(Steps, SkipHidden)
Case emMove.eLeft
Move = Left(Steps, SkipHidden)
Case emMove.eUpEnd
Move = UpEnd(Steps, SkipHidden)
Case emMove.eDownEnd
Move = DownEnd(Steps, SkipHidden)
Case emMove.eRightEnd
Move = RightEnd(Steps, SkipHidden)
Case emMove.eLeftEnd
Move = LeftEnd(Steps, SkipHidden)
Case emMove.eUpMost
Move = UpMost(SkipHidden)
Case emMove.eDownMost
Move = DownMost(SkipHidden)
Case emMove.eRightMost
Move = RightMost(SkipHidden)
Case emMove.eLeftMost
Move = LeftMost(SkipHidden)
End Select
End Function

'=============================================================================
' Move To Direction
Private Function OneStep(Direction As emMove, Optional SkipHidden As Boolean = False) As Boolean
OneStep = False
On Error GoTo Error
Do
Select Case Direction
Case emMove.eUp
ActiveCell.Offset(-1, 0).Range("A1").Select
Case emMove.eDown
ActiveCell.Offset(1, 0).Range("A1").Select
Case Else
Exit Do
End Select
Loop Until SkipHidden = False Or ActiveCell.EntireRow.Hidden = False

Do
Select Case Direction
Case emMove.eRight
ActiveCell.Offset(0, 1).Range("A1").Select
Case emMove.eLeft
ActiveCell.Offset(0, -1).Range("A1").Select
Case Else
Exit Do
End Select
Loop Until SkipHidden = False Or ActiveCell.EntireColumn.Hidden = False

OneStep = True
Exit Function
Error:
OneStep = False
End Function

Private Function MoreSteps(Direction As emMove, Optional Steps As Long = 1, Optional SkipHidden As Boolean = False) As Boolean
If Steps < 0 Then Direction = Direction * -1: Steps = Steps * -1
For i = 1 To Steps
If OneStep(Direction, SkipHidden) = False Then MoreSteps = False: Exit Function
Next
MoreSteps = True
End Function

Function Up(Optional Steps As Long = 1, Optional SkipHidden As Boolean = False) As Boolean
Up = MoreSteps(eUp, Steps:=Steps, SkipHidden:=SkipHidden)
End Function
Function Down(Optional Steps As Long = 1, Optional SkipHidden As Boolean = False) As Boolean
Down = MoreSteps(eDown, Steps:=Steps, SkipHidden:=SkipHidden)
End Function
Function Left(Optional Steps As Long = 1, Optional SkipHidden As Boolean = False) As Boolean
Left = MoreSteps(eLeft, Steps:=Steps, SkipHidden:=SkipHidden)
End Function
Function Right(Optional Steps As Long = 1, Optional SkipHidden As Boolean = False) As Boolean
Right = MoreSteps(eRight, Steps:=Steps, SkipHidden:=SkipHidden)
End Function

'=============================================================================
' Move To Direction End
Private Function OneStepEnd(Direction As emMove, Optional SkipHidden As Boolean = False) As Boolean
OneStepEnd = True
Do
Select Case Direction
Case emMove.eUpEnd
If ActiveCell.Row = 1 Then OneStepEnd = False: Exit Function
Selection.End(xlUp).Select
Case emMove.eDownEnd
If ActiveCell.Row = Rows.Count Then OneStepEnd = False: Exit Function
Selection.End(xlDown).Select
Case Else
Exit Do
End Select
Loop Until SkipHidden = False Or ActiveCell.EntireRow.Hidden = False

Do
Select Case Direction
Case emMove.eLeftEnd
If ActiveCell.Column = 1 Then OneStepEnd = False: Exit Function
Selection.End(xlToLeft).Select
Case emMove.eRightEnd
If ActiveCell.Column = Columns.Count Then OneStepEnd = False: Exit Function
Selection.End(xlToRight).Select
Case Else
Exit Do
End Select
Loop Until SkipHidden = False Or ActiveCell.EntireColumn.Hidden = False
End Function

Private Function MoreStepsEnd(Direction As emMove, Optional Steps As Long = 1, Optional SkipHidden As Boolean = False) As Boolean
If Steps < 0 Then Direction = Direction * -1: Steps = Steps * -1
For i = 1 To Steps
If OneStep(Direction, SkipHidden) = False Then MoreStepsEnd = False: Exit Function
Next
MoreStepsEnd = True
End Function

Function UpEnd(Optional Steps As Long = 1, Optional SkipHidden As Boolean = False) As Boolean
UpEnd = MoreStepsEnd(eUpEnd, Steps:=Steps, SkipHidden:=SkipHidden)
End Function
Function DownEnd(Optional Steps As Long = 1, Optional SkipHidden As Boolean = False) As Boolean
DownEnd = MoreStepsEnd(eDownEnd, Steps:=Steps, SkipHidden:=SkipHidden)
End Function
Function LeftEnd(Optional Steps As Long = 1, Optional SkipHidden As Boolean = False) As Boolean
LeftEnd = MoreStepsEnd(eLeftEnd, Steps:=Steps, SkipHidden:=SkipHidden)
End Function
Function RightEnd(Optional Steps As Long = 1, Optional SkipHidden As Boolean = False) As Boolean
RightEnd = MoreStepsEnd(eRightEnd, Steps:=Steps, SkipHidden:=SkipHidden)
End Function

'=============================================================================
' Move To Direction Most
Private Function OneStepMost(Direction As emMove, Optional SkipHidden As Boolean = False) As Boolean
OneStepMost = False
Select Case Direction
Case emMove.eUpMost
Cells(1, ActiveCell.Column).Select
Case emMove.eDownMost
Cells(Rows.Count, ActiveCell.Column).Select
Case emMove.eLeftMost
Cells(ActiveCell.Row, 1).Select
Case emMove.eRightMost
Cells(ActiveCell.Row, Columns.Count).Select
Case Else
Exit Function
End Select

If ActiveCell.FormulaR1C1 = "" Then OneStepEnd Direction, SkipHidden:=SkipHidden
If ActiveCell.FormulaR1C1 = "" Then
If Direction = eUpMost Then Cells(1, ActiveCell.Column).Select
If Direction = eLeftMost Then Cells(ActiveCell.Row, 1).Select
OneStepMost = False
Else
OneStepMost = True
End If
End Function

Function UpMost(Optional SkipHidden As Boolean = False) As Boolean
UpMost = OneStepMost(eUpMost, SkipHidden:=SkipHidden)
End Function
Function DownMost(Optional SkipHidden As Boolean = False) As Boolean
DownMost = OneStepMost(eDownMost, SkipHidden:=SkipHidden)
End Function
Function LeftMost(Optional SkipHidden As Boolean = False) As Boolean
LeftMost = OneStepMost(eLeftMost, SkipHidden:=SkipHidden)
End Function
Function RightMost(Optional SkipHidden As Boolean = False) As Boolean
RightMost = OneStepMost(eRightMost, SkipHidden:=SkipHidden)
End Function

magicalclick at 2007-8-31 > top of Msdn Tech,Microsoft ISV Community Center Forums,Visual Basic for Applications (VBA)...
# 4

Jonas,

The user selection thats selected using the InputBox is a Range object, the range object has Row and Column properties which I hope is the what your looking for.

'selects the cell and returns the value of that cell
Dim myRange As Range
Set myRange = Application.InputBox(prompt:="Select the cell containing the data you want.", Type:=8)
If myRange Is Nothing Then
'cancel pressed
Else
MsgBox myRange.Row
MsgBox myRange.Column
End If

There was a small error in the original posted code (If Not myRange is Nothing should have been If myRange is Nothing)

DerekSmyth at 2007-8-31 > top of Msdn Tech,Microsoft ISV Community Center Forums,Visual Basic for Applications (VBA)...
# 5
Thanks again Derek! It works just perfect.
Jonas.S at 2007-8-31 > top of Msdn Tech,Microsoft ISV Community Center Forums,Visual Basic for Applications (VBA)...