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