0

Final One:enter image description hereI want to insert blank row with a specific column range above a particular row. For example: There were 2 sets of data in a single sheet ,ie, 1st set col A to Col E and 2nd set Col F to Col J. I need to compare Column Ai with Column Fi (where i indicates the position of row) and if both values are same then the comparison can be proceeded like Bi with Gi, Ci with Hi and so and so and if not, I need to shift that set of 2nd data Fi to Ji to next row..ie. if the whole set is in 6th position I need to shift them down to 7th position and make the 6th position of Fi to Ji blank....

 Sub Dcompare()
 Dim endRow As Long
 Dim lRow As Long
 Dim ws As Worksheet

 Set ws = ThisWorkbook.Worksheets(1)

 endRow = Sheet1.Range("A999999").End(xlUp).Row
 For i = 2 To endRow
 If Sheet1.Range("A" & i).Value = Sheet1.Range("F" & i).Value Then
    Sheet1.Range("K" & i).Value = "Yes"

 Else
 ws.Range("F" & i & ":J" & i).Offset(1, 0).Value = ws.Range("F" & i & ":J" &    i).Value
 ws.Range("F" & i & ":J" & i).Value = ""


 End If 

 Next i

For j = 2 To endRow
If Sheet1.Range("K" & j).Value = "Yes" Then
If Sheet1.Range("B" & j).Value = Sheet1.Range("G" & j).Value Then
   Sheet1.Range("L" & j).Value = "Yes"
Else
    Sheet1.Range("L" & j).Value = "No"
End If
If Sheet1.Range("C" & j).Value = Sheet1.Range("H" & j).Value Then
   Sheet1.Range("M" & j).Value = "Yes"
Else
    Sheet1.Range("M" & j).Value = "No"
End If
If Sheet1.Range("D" & j).Value = Sheet1.Range("I" & j).Value Then
    Sheet1.Range("N" & j).Value = "Yes"
Else
    Sheet1.Range("N" & j).Value = "No"
End If
If Sheet1.Range("E" & j).Value = Sheet1.Range("J" & j).Value Then
     Sheet1.Range("O" & j).Value = "Yes"
Else
    Sheet1.Range("O" & j).Value = "No"
End If
End If
Next j
End Sub


------>Final Code Inserted---------

Sub Dcompare()
Dim endRow As Long
Dim ws As Worksheet
Dim dShift As Boolean
Set ws = ThisWorkbook.Worksheets(1)
endRow = ws.Range("A999999").End(xlUp).Row
For i = 2 To endRow + 1

If ws.Range("A" & i).Value = ws.Range("F" & i).Value Then
dShift = False
ws.Range("K" & i).Value = "Yes"
Else
If Not dShift Then
ws.Range("F" & i & ":J" & i).Insert Shift:=xlDown,               CopyOrigin:=xlFormatFromLeftOrAbove
ws.Range("A" & i + 1 & ":E" & i + 1).Insert Shift:=xlDown,   CopyOrigin:=xlFormatFromLeftOrAbove
     endRow = endRow + 1
     dShift = True
     Else
     dShift = False
     End If
     End If


 j = i
 If ws.Range("K" & j).Value = "Yes" Then
 If ws.Range("B" & j).Value = ws.Range("G" & j).Value Then
 ws.Range("L" & j).Value = "Yes"
 Else
     ws.Range("L" & j).Value = "No"
 End If
 If ws.Range("C" & j).Value = ws.Range("H" & j).Value Then
    ws.Range("M" & j).Value = "Yes"
 Else
     ws.Range("M" & j).Value = "No"
 End If
 If ws.Range("D" & j).Value = ws.Range("I" & j).Value Then
     ws.Range("N" & j).Value = "Yes"
 Else
     ws.Range("N" & j).Value = "No"
 End If
 If ws.Range("E" & j).Value = ws.Range("J" & j).Value Then
      ws.Range("O" & j).Value = "Yes"
 Else
     ws.Range("O" & j).Value = "No"
 End If
 Else
 End If

 Next i
 MsgBox "The value of endRow is : " & endRow, vbInformation

 End Sub
Improve this question
10
  • What is the new problem you were talking about in the comment to my answer? Commented Jun 8, 2017 at 12:42
  • @Vegard more than one blank row is inserted nw.. Commented Jun 9, 2017 at 5:02
  • @Vegard: Please refer the image of the current output attached with the question..there u can see that more than one blank row is inserted...I need only single blank row ... Commented Jun 9, 2017 at 5:27
  • So when a line is evaluated and found to not match, you want it moved down 1 row and nothing more, regardless of other circumstances? Commented Jun 9, 2017 at 7:39
  • yes..that 2nd set of row(F->J)...and after moving down the comparison should continue till it find the matching value..... Commented Jun 9, 2017 at 8:18

1 Answer 1

Reset to default
1

Based on your explanations, this is what I interpret your challenge as:

  • Evaluate Ai with Fi --> Ei with Ji from left to right, and indicate in helper-columns whether the evaluation succeeded or not
  • If the first evaluation is Not Equal, offset the range Fi:Ji downwards exactly one row
  • If a range has been shifted down, the loop should evaluate this line but never shift it again regardless of outcome of the evaluation

This code satisfies those conditions (change i and other row variables to your needs):

Sub Dcompare()
    Dim endRow As Long
    Dim ws As Worksheet
    Dim dShift As Boolean

    Set ws = ThisWorkbook.Worksheets(1)
    endRow = ws.Range("A999999").End(xlUp).Row

    ' Set initial value of helper columns to no - saves miniscule time and complexity in the loop
    ws.Range("L" & 1 & ":O" & endRow).Value = "No"

    For i = 1 To endRow
        If ws.Range("A" & i).Value = ws.Range("F" & i).Value Then
            dShift = False
            ws.Range("L" & i).Value = "Yes"
        Else
            If Not dShift Then
                ws.Range("F" & i & ":J" & i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

                ' Remember that we just shifted a row
                dShift = True
            Else
                ' Reset shift counter
                dShift = False
            End If
        End If

        For j = 2 To 4
            If dShift Then Exit For
            If ws.Cells(i, j).Value = ws.Cells(i, j + 5).Value Then ws.Cells(i, j + 11).Value = "Yes"
        Next j
    Next i
End Sub

However, it seems strange to me that you would want this functionality? Please confirm that it is correct. The behavior it yields in the worksheet is very strange.

Let me show with images. Orange background means the code will show the cell as a match. Green background means the code will show that the cell doesn't match.

Before the code it looks like this:

enter image description here

After the code it looks like this:

enter image description here

Improve this answer
Sign up to request clarification or add additional context in comments.

18 Comments

Edit your question with the code you are using and describe more closely what the problem is, and I'll see if I can help.
Thankyou so much...now I can shift down the row , but seems to be some problem with the loop...I am sharing my code with this...can u plz hav a look on this.... Set ws = ThisWorkbook.Worksheets(1) endRow = Sheet1.Range("A999999").End(xlUp).Row For i = 2 To endRow If Sheet1.Range("A" & i).Value = Sheet1.Range("F" & i).Value Then Sheet1.Range("K" & i).Value = "Yes" Else ws.Range("F" & i & ":J" & i).Offset(1, 0).Value = ws.Range("F" & i & ":J" & i).Value ws.Range("F" & i & ":J" & i).Value = "" End If, Next i For j = 2 To endRow rest of the comparison.if the above condition is true/yes
Put this code into your question, so you can format it proper. It's very hard to read this code in a comment. You should also describe the problem you are having more closely.
Well, the images are made using the code that is currently in the answer, so if that truly is the functionality you wanted, it should be pretty much ready for use as soon as you re-define i and change the 1 in the first commented line of code.
Yes,above images shows the expected behaviour. 1. Evaluate Ai with Fi --> Ei with Ji from left to right, and indicate in helper-columns whether the evaluation succeeded or not: correct assumption 2. If any of the evaluations are Not Equal, offset the range Fi:Ji downwards exactly one row: not any of the evaluations, only Ai and Fi. In the case of other cells just output as False in helper columns.Other cells are compared only when Ai=Fi 3. If a range has been shifted down, the loop should evaluate this line but never shift it again regardless of outcome of the evaluation: crct assmption
|

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.