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.
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.