robashqaiser
New Member
- Joined
- Mar 2, 2021
- Messages
- 3
- Office Version
- 2013
- Platform
- Windows
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
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
VBA Code:
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
Attachments
Last edited by a moderator: