Sub ParseRange_Locator()
Dim SelAddress As String, LeftColumn As String, LeftRow As Long, Msg As String
Dim RightColumn As String, RightRow As Long, TestAddress As String, i As Long
TestAddress = vbNullString
Test1:
Call ParseRange(, LeftColumn, LeftRow, RightColumn, RightRow)
i = 1
GoTo Result
Test2:
Call ParseRange(, , LeftRow)
i = 2
GoTo Result
Test3:
TestAddress = "$J$23:$AZ$84"
Call ParseRange(TestAddress, LeftColumn, LeftRow)
i = 3
GoTo Result
Test4:
TestAddress = "K$18:$BZ102"
Call ParseRange(TestAddress, , LeftRow, , RightRow)
i = 4
Result:
If TestAddress = vbNullString Then TestAddress = Selection.Address(False, False)
Msg = "Test " & i & vbCr & vbCr & "The values returned by 'ParseRange' are:" & vbCr & _
"Addressed parsed:" & vbTab & """" & TestAddress & """" & vbCr
If LeftColumn <> "" Then Msg = Msg & "LeftColumn:" & vbTab & """" & LeftColumn & """" & vbCr
If LeftRow <> 0 Then Msg = Msg & "LeftRow:" & vbTab & vbTab & """" & LeftRow & """" & vbCr
If RightColumn <> "" Then Msg = Msg & "RightColumn:" & vbTab & """" & RightColumn & """" & vbCr
If RightRow <> 0 Then Msg = Msg & "RightRow:" & vbTab & """" & RightRow & """"
MsgBox Msg, , "Procedure 'ParseRange_Locator'"
LeftColumn = vbNullString: LeftRow = 0: RightColumn = vbNullString: RightRow = 0
TestAddress = vbNullString
Select Case i
Case 1: GoTo Test2
Case 2: GoTo Test3
Case 3: GoTo Test4
End Select
End Sub
Sub ParseRange(Optional RefAddress As String = vbNullString, _
Optional LeftColumn As String = vbNullString, _
Optional LeftRow As Long = 0, _
Optional RightColumn As String = vbNullString, _
Optional RightRow As Long = 0)
Dim Ary1 As Variant, Ary2 As Variant, N As Integer, Msg As String
Const Title As String = "Procedure 'ParseRange'"
On Error GoTo ErrMsg
If RefAddress = vbNullString _
Then RefAddress = ActiveWindow.RangeSelection.Address(, False)
RefAddress = Application.ConvertFormula(Formula:=RefAddress, _
FromReferenceStyle:=xlA1, _
ToReferenceStyle:=xlA1, _
ToAbsolute:=xlAbsolute)
Ary1 = Split(RefAddress, "$")
Ary2 = Split(Ary1(2), ":")
LeftColumn = Ary1(1)
LeftRow = Ary2(0)
On Error Resume Next
RightColumn = Ary1(3)
RightRow = Ary1(4)
GoTo Finish
ErrMsg:
Select Case Err.Number
Case 438, 1004, 9: Msg = "A range is not currently selected or specified." & vbCr
Case Else: Msg = "An unexpected error occurred in macro 'ParseRange'." & vbCr
End Select
Msg = Msg & "Error number: " & Err.Number & vbCr & _
"Descrip: " & Err.Description
Resume Contin
Contin:
MsgBox Msg, vbCritical, Title
LeftColumn = vbNullString
LeftRow = -1
RightColumn = vbNullString
RightRow = -1
Finish:
On Error Resume Next
Erase Ary1
On Error Resume Next
Erase Ary2
End Sub
|