Comparing 1 value with two other columns Loop

[I3atnumb3rs]

Hello,

I'm trying to create a loop that checks the names in column A with the names in column D and E. If The names in A are different from either D or E and the cells aren't empty I want to duplicate the line. I got the line duplicating, but it's not ignoring empty cells and duplicating anyway. Please help!

Sub DiffNames()


'Loop trough rows, if D != E create a new lines




Application.ScreenUpdating = False


Dim lngRow As Long
Dim Number

With ActiveSheet

lngRow = .Cells(65536, 1).End(xlUp).Row



Do

If IsEmpty(.Cells(lngRow, 4)) = False And _
IsEmpty(.Cells(lngRow, 5)) = False And _
.Cells(lngRow, 1) <> .Cells(lngRow, 4) = True Or _
.Cells(lngRow, 1) <> .Cells(lngRow, 5) = True Then


.Cells(lngRow, 1).EntireRow.Select
Selection.EntireRow.Copy
Selection.EntireRow.Insert Shift:=xlDown



End If




lngRow = lngRow - 1
Loop Until lngRow = 1

End With


End Sub

 

[MickG]

Try :-

[COLOR="Navy"]Sub[/COLOR] MG04Sep02
[COLOR="Navy"]Dim[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
n = 1
[COLOR="Navy"]While[/COLOR] Cells(n, "A") <> ""
  [COLOR="Navy"]If[/COLOR] Not IsEmpty(Cells(n, "D")) And Not IsEmpty(Cells(n, "E")) [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]If[/COLOR] Not Cells(n, "A") = Cells(n, "D") Or Not Cells(n, "A") = Cells(n, "E") [COLOR="Navy"]Then[/COLOR]
        Cells(n, "A").EntireRow.Copy
        Cells(n, "A").EntireRow.Insert Shift:=xlDown
        n = n + 1
    [COLOR="Navy"]End[/COLOR] If
  [COLOR="Navy"]End[/COLOR] If
    n = n + 1
Wend
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[I3atnumb3rs]

Thanks, but it didn't work. It duplicated every single line with that code

 

[MickG]

Can you show an example of your initial data in "A,D,& E"

 

[I3atnumb3rs]

http://prntscr.com/p1rely basically would only want to duplicate rows with victor in either D or E

 

[I3atnumb3rs]

But the names can change so shouldn't be specific to Victor.

 

[MickG]

When my code is run on that data the 2nd ,3rd and 5th lines are duplicated , where is that incorrect ???

 

[I3atnumb3rs]

This is what happens when I run your code http://prntscr.com/p1s33e

 

[MickG]

Below is a Test file with your Data.
Run the code a couple of times , see if its working , then try with your data !!!
https://app.box.com/s/gy8yacldolx591wzaowx1sen3l03kl9k

 

[I3atnumb3rs]

When I run the code this is what I get, there are a few lines with only the name Victor in one column that don't duplicate: http://prntscr.com/p1sfu8

I changed my code around a bit and got it to do what I wanted Thanks for your time tho.

Sub DiffNames()


'Loop trough rows, if D != E create a new lines




Application.ScreenUpdating = False


Columns("D:E").Select
Selection.Replace What:="", Replacement:="1", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False


Dim lngRow As Long


With ActiveSheet

lngRow = .Cells(65536, 1).End(xlUp).Row



Do

If .Cells(lngRow, 1) <> .Cells(lngRow, 4) = True And _
.Cells(lngRow, 4) <> 1 = True Or _
.Cells(lngRow, 1) <> .Cells(lngRow, 5) = True And _
.Cells(lngRow, 5) <> 1 = True Then


.Cells(lngRow, 1).EntireRow.Select
Selection.EntireRow.Copy
Selection.EntireRow.Insert Shift:=xlDown


End If




lngRow = lngRow - 1
Loop Until lngRow = 1

End With

Columns("D:E").Select
Selection.Replace What:="1", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False



End Sub