Vba Excel: usando a condição da coluna OR sem duplicar linha

Question

Esta é uma versão atualizada para isso .

A solução acima é boa, até que eu percebi quando eu coloquei dados massivos, o loop for gera linhas duplicadas (que resultados indesejados)

Encontrei algum método on-line para remover linhas duplicadas.

ActiveSheet.Range("A:F").RemoveDuplicates Columns:=1, Header:=xlNo

Mas foi um pouco perdendo tempo para gerar os dados atualizados e, em seguida, excluir os duplicados depois.

O meu LOGIC está causando duplicatas?

Deixe-me declarar um exemplo para o meu problema agora,

code name description status    
4566 Adam al          active

Porque Adam é um jogo e também ativo, recebo 4566; o registro.
Mas na minha lógica, eu recebo outro 4566.

Obrigado. Qualquer conselho sobre função / método ou código será apreciado.

EDITAR
Código é o valor único neste grupo de dados. Eu tenho Xsheet onde ambas as colunas são independentes e desiguais, mas não duplicadas (esta folha é dinâmica).

• Folha1 são os dados originais gerados, um banco de dados dinâmico.
• O Xsheet e o Sheet1 são dados aleatórios que não são classificados.

O que estou tentando fazer.

If the Name or the Description on the Master List (Xsheet) is found in the Data Sheet (Sheet1) and it is also Active, then copy it to a new sheet without duplicates (of same code to Sheet2). As some of the code had the matching Name also the Description.

Aparentemente, duplicatas não são o único problema que eu tive, mas achei que deveria resolvê-las uma de cada vez. Eu crio uma nova pergunta para o outro problema quando não recebi resposta para essa pergunta.

Isso é Xsheet.

name    description
Adam    al
Edward  dc
Rose    tp
Jen 
Owen    
Jack    
Belle   
Sally   
Cindy   
Max 
Zack    
Moon    
Shawn   

Esta é a Folha1.

code    operation   title   date    name    description status
4566                Adam    ttr active
4899                Edward  ttp inactive
4987                Adam    dc  active
4988                Kris    al  active
4989                Chris   ttr inactive
5713                Mary    rt  active
5312                Ken     active
3211                John        active
2138                Summer      active
3334                Wendy       active
5417                Adam        active
3355                Belle       active
4773                Adam        active
3288                Ron     inactive
1289                Wincy   dc  active

Isso é vba.

Sub Procedure2()

Dim xsht As Worksheet
Dim sht As Worksheet 'original sheet
Dim newsht As Worksheet 'sheet with new data

Application.ScreenUpdating = False

Set xsht = ThisWorkbook.Worksheets("Xsheet")
Set sht = ThisWorkbook.Worksheets("Sheet1")
Set newsht = ThisWorkbook.Worksheets("Sheet2")

Set main = xsht.Range("A1")
Set dat = sht.Range("A1")
Set newdat = newsht.Range("A1")

'initialise counters
Dim i, j, iRow As Integer   'instantiate and initialize the integers
i = 1
j = 1
iRow = 1

'set heading on sheet2
newdat.Offset(0, 0).Value = dat.Offset(0, 0).Value 'copy code
newdat.Offset(0, 1).Value = dat.Offset(0, 2).Value 'copy title
newdat.Offset(0, 2).Value = dat.Offset(0, 3).Value 'copy date
newdat.Offset(0, 3).Value = dat.Offset(0, 4).Value 'copy name
newdat.Offset(0, 4).Value = dat.Offset(0, 5).Value 'copy descr
newdat.Offset(0, 5).Value = dat.Offset(0, 6).Value 'copy status

Do While main.Offset(i, 0).Value <> "" Or main.Offset(i, 1).Value <> ""

  j = 1     'reset DataSheet pointer

  Do While dat.Offset(j, 0).Value <> ""

    If (main.Offset(i, 0).Value = dat.Offset(j, 4).Value _
    Or main.Offset(i, 1).Value = dat.Offset(j, 5).Value) _
    And dat.Offset(j, 6).Value = "active" Then

      newdat.Offset(iRow, 0).Value = dat.Offset(j, 0).Value 'copy code
      newdat.Offset(iRow, 1).Value = dat.Offset(j, 2).Value 'copy title
      newdat.Offset(iRow, 2).Value = dat.Offset(j, 3).Value 'copy date
      newdat.Offset(iRow, 3).Value = dat.Offset(j, 4).Value 'copy name
      newdat.Offset(iRow, 4).Value = dat.Offset(j, 5).Value 'copy descr
      newdat.Offset(iRow, 5).Value = dat.Offset(j, 6).Value 'copy status
      iRow = iRow + 1
    End If
    j = j + 1     'increment DataSheet pointer; fast moving; changing/resetting
  Loop

  i = i + 1     'increment XSheet pointer; slow moving outer loop; not resetting
Loop

Application.ScreenUpdating = True

End Sub

    

Answer 1

This is the sentence you summarized up my situation last time.
"If the Name or the Description on the Master List is found in the Data Sheet and it is also Active, then copy it to a new sheet".

Sub check_listX()

'Set dat = sht.Range("code").Cells(1,1)
Set main = ThisWorkbook.Worksheets("Xsheet").Range("A1")
Set dat = ThisWorkbook.Worksheets("Sheet1").Range("A1")
Set newdat = ThisWorkbook.Worksheets("Sheet2").Range("A1")

'initialise counters
Dim i, j, iRow As Integer   'instantiate and initialize the integers
i = 1
j = 1
iRow = 1

'set heading on sheet2
newdat.Offset(0, 0).Value = dat.Offset(0, 0).Value 'copy code
newdat.Offset(0, 1).Value = dat.Offset(0, 2).Value 'copy title
newdat.Offset(0, 2).Value = dat.Offset(0, 3).Value 'copy date
newdat.Offset(0, 3).Value = dat.Offset(0, 4).Value 'copy name
newdat.Offset(0, 4).Value = dat.Offset(0, 5).Value 'copy descr
newdat.Offset(0, 5).Value = dat.Offset(0, 6).Value 'copy status

Do While main.Offset(i, 0).Value <> "" Or main.Offset(i, 1).Value <> ""

  j = 1     'reset DataSheet pointer

  Do While dat.Offset(j, 0).Value <> ""

  If dat.Offset(j, 6).Value = "active" _
      And main.Offset(i, 0) = dat.Offset(j, 4) _
      Or main.Offset(i, 1) = dat.Offset(j, 5) _
      And dat.Offset(j, 5) <> "" Then

      newdat.Offset(iRow, 0).Value = dat.Offset(j, 0).Value 'copy code
      newdat.Offset(iRow, 1).Value = dat.Offset(j, 2).Value 'copy title
      newdat.Offset(iRow, 2).Value = dat.Offset(j, 3).Value 'copy date
      newdat.Offset(iRow, 3).Value = dat.Offset(j, 4).Value 'copy name
      newdat.Offset(iRow, 4).Value = dat.Offset(j, 5).Value 'copy descr
      newdat.Offset(iRow, 5).Value = dat.Offset(j, 6).Value 'copy status
      iRow = iRow + 1
    End If
    j = j + 1     'increment DataSheet pointer; fast moving; changing/resetting
  Loop

  i = i + 1     'increment XSheet pointer; slow moving outer loop; not resetting
Loop
End Sub