Moving cells upto a specific text with Vba

robashqaiser

New Member
Joined
Mar 2, 2021
Messages
3
Office Version
  1. 2013
Platform
  1. 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

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

  • Code output.png
    Code output.png
    35.6 KB · Views: 6
Last edited by a moderator:

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.

rollis13

Active Member
Joined
Jul 30, 2012
Messages
426
Office Version
  1. 2016
Platform
  1. Windows
Just to add missing cross-post link: LINK
 
Last edited:

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,856
Office Version
  1. 365
Platform
  1. Windows
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,130,124
Messages
5,640,249
Members
417,131
Latest member
Seanr19871

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top