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:
Code: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![]()




Reply With Quote
Bookmarks