CODEWITHSUNDEEP
excelvba
M.Cici
M.Cici

Reputation: 13

Inserting blank rows in VBA excel

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

Upvotes: 0

Views: 647

Answers (1)

Vegard
Vegard

Reputation: 4882

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

Upvotes: 1

Related Questions