Moving cells upto a specific text with Vba

[robashqaiser]

Hi, I am newbie to excel vba. I am trying to to search the text with a specific delimiter and then want to align the cells present in both column if both cells value are same. I tried to write a code for this but its not working according to my needs. Could anyone please help me to sort the error in the code.

in my code output which is attached below,the code only reads the length of the string upto the second vertica;l slash but i want it to read the text and align accordingly.

Please anyone help me to find the error in my code.

Thanks in advance

Sub Similar_Match()

Dim Last_rw As Double
Dim Final_rw As Double

FindingLastRow Last_rw
'Last_rw1 = Range("F" & Rows.Count).End(xlUp).Row

'Working on First Column

i = 8
Do Until i > Last_rw
    If Len(Cells(i, 2)) > 0 Then
        Temp = InStr(1, Cells(i, 2), "|", vbTextCompare)
        temp1 = InStr(Temp + 1, Cells(i, 2), "|", vbTextCompare)
        If temp1 = 0 Then
            ValueL = ""
        Else
            ValueL = Left(Cells(i, 2), temp1)
        End If
    Else
        ValueL = Cells(i, 2)
    End If
    'working on second column
    If Len(Cells(i, 5)) > 0 Then
    'searching upto 2nd straight line
   
        Temp = InStr(1, Cells(i, 5), "|", vbTextCompare)
        temp1 = InStr(Temp + 1, Cells(i, 5), "|", vbTextCompare)
        If temp1 = 0 Then
            ValueR = ""
        Else
            ValueR = Left(Cells(i, 5), temp1) 'starting from left
        End If
    Else
        ValueR = Cells(i, 5)
    End If
       'Values different on both sides, adding cells
    If ValueL <> ValueR Then
        For j = i + 1 To Last_rw
            If ValueL = Left(Cells(j, 5), Len(ValueL)) And ValueL <> "" Then  (I find the error in this line, I tried to use mid function along the strFunction but its not working.)
          'Select Range for inserting blank cells
          Range(Cells(i, 2), Cells(j - 1, 2)).Select
                Selection.Insert Shift:=xlDown
                i = j
                Exit For
            End If
            If ValueR = Left(Cells(j, 2), Len(ValueR)) And ValueR <> "" Then   (I find the error in this line, I tried to use mid function along the strFunction but its not working.)
                Range(Cells(i, 5), Cells(j - 1, 5)).Select
                Selection.Insert Shift:=xlDown
                i = j
                Exit For
            End If
        Next j
    End If
    FindingLastRow Last_rw
    i = i + 1
Loop


End Sub

 

[rollis13]

Just to add missing cross-post link: LINK

 

[Fluff]

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: Moving cells upto a specific text with Vba using Instr function - OzGrid Free Excel/VBA Help Forum
If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.