PDA

View Full Version : VBA - Find Last End Value



ivandgreat
05-01-2013, 07:48 PM
Hi,

Anyone could help me on this,

VBA Find Last Point (http://www.mrexcel.com/forum/excel-questions/700358-visual-basic-applications-find-last-point.html)

br,

Admin
05-01-2013, 11:05 PM
Hi

try this


Option Explicit

Sub kTest()

Dim r As Range

Set r = Range("a1").CurrentRegion

With r
With r.Columns(1).Offset(, r.Columns.Count)
.FormulaR1C1 = "=iferror(lookup(2,1/(" & r.Columns(2).Address(, , -4150) & "=rc[-1])," & r.Columns(3).Address(, , -4150) & "),rc[-1])"
.Value = .Value
.Cells(1) = "Last"
End With
End With

End Sub

LalitPandey87
05-02-2013, 09:55 AM
If below is the input



Item
Start
End


1
A001
A002


2
A002
A003


3
A003
A005


4
A006
A007


5
A005
A006



then the output will be



m
Start
End
Last


1
A001
A002
A007


2
A002
A003
A007


3
A003
A005
A007


4
A006
A007
A007


5
A005
A006
A007



In that case the solution give by Admin will not work as i have tested it in my system

Below code will work in both cases:



Option Explicit


Sub LMP_Test()


Dim varArrData() As Variant
Dim varArrTemp() As Variant
Dim varArrTemp1() As Variant
Dim lngLoop As Long
Dim lngIndex As Long
Dim varVal2 As Variant
Dim strOutput As String


Const lngStartCol As Long = 2 'Change accordingly
Const lngEndCol As Long = 3 'Change accordingly
Const strDataStartCell As String = "A1" 'Change accordingly
Const strSheetName As String = "Sheet1" 'Change accordingly

With ThisWorkbook.Worksheets(strSheetName)
varArrData = .Range(strDataStartCell).CurrentRegion.Value
varArrTemp = varArrData
ReDim varArrTemp1(1 To UBound(varArrTemp), 1 To 1)
varArrTemp1(1, 1) = "Last"
For lngLoop = LBound(varArrTemp) + 1 To UBound(varArrTemp)
varVal2 = varArrTemp(lngLoop, lngEndCol)
strOutput = varVal2
DoLoop:
If varVal2 = "" Then GoTo ContinueForLoop
lngIndex = GetArrayIndex(varVal2, varArrTemp, , lngStartCol)
If lngIndex > 0 Then
varVal2 = varArrTemp(lngIndex, lngEndCol)
strOutput = varVal2
Else
varVal2 = vbNullString
End If
lngIndex = 0
GoTo DoLoop
ContinueForLoop:
varArrTemp1(lngLoop, 1) = strOutput
strOutput = vbNullString
Next lngLoop
.Range(strDataStartCell).Offset(, UBound(varArrData, 2)).Resize(UBound(varArrTemp1), 1) = varArrTemp1
End With

Erase varArrData
Erase varArrTemp
Erase varArrTemp1
lngLoop = Empty
lngIndex = Empty
varVal2 = Empty
strOutput = vbNullString


End Sub


Function GetArrayIndex(ByVal Val As Variant, ByVal varArr As Variant, Optional ByVal lngRowNo As Long = 0, _
Optional ByVal lngColNo As Long = 0) As Long


Dim varDataArr As Variant
Dim lngLoop As Long

GetArrayIndex = 0
lngLoop = 0
If lngRowNo > 0 And lngColNo = 0 Then
For lngLoop = LBound(varArr) To UBound(varArr, 2)
If varArr(lngRowNo, lngLoop) = Val Then
GetArrayIndex = lngLoop
Exit For
End If
Next lngLoop
ElseIf lngRowNo = 0 And lngColNo > 0 Then
For lngLoop = LBound(varArr) To UBound(varArr)
If varArr(lngLoop, lngColNo) = Val Then
GetArrayIndex = lngLoop
Exit For
End If
Next lngLoop
ElseIf lngRowNo = 0 And lngColNo = 0 Then
GetArrayIndex = lngLoop = 0
End If

varDataArr = Empty
lngLoop = Empty


End Function

:cheers:

ivandgreat
05-02-2013, 10:37 AM
It works very well.

Thanks a lot LalitPandey87.