1

This is an updated version for this.

The above solution is good, until I realized when I put in massive data, the for loop generates duplicate rows (which unwanted results)

I found some method online to remove duplicate row.

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

But it was a bit wasting time to generate the updated data, then delete the duplicates after.

Is my LOGIC causing duplicates?

Let me state an example for my problem now,

code name description status    
4566 Adam al          active

Because Adam is a match and also active, I get 4566; the record.
But in my logic, I get another 4566.

Thank you. Any advice on function/method or code will be appreciated.

EDIT
Code is the unique value in this bunch of data. I have Xsheet where both columns are independent and uneven, but no duplicates (this sheet is dynamic).

  • Sheet1 is the original data generated, a dynamic database.
  • Both Xsheet and Sheet1 are random data that are not sorted.

What i am trying to do.

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.

Apparently, duplicates is not the only problem I had, but I thought I should solve them one at a time. I create a new question for the other problem when I got no reply for this question.

This is Xsheet.

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

This is Sheet1.

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

This is 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
3
  • Comments are not for extended discussion; this conversation has been moved to chat.
    – Journeyman Geek
    Apr 27, 2017 at 6:40
  • @JourneymanGeek Thank you. I thought of this too, but at the time the OP didn't have enough "points" to communicate in chat.
    – ejbytes
    Apr 27, 2017 at 7:41
  • Please don't forget to accept the solution.
    – ejbytes
    Apr 27, 2017 at 17:49

1 Answer 1

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
1
  • @ExcelNovice You're welcome!
    – ejbytes
    Apr 30, 2017 at 17:30

You must log in to answer this question.

Not the answer you're looking for? Browse other questions tagged .