Wednesday 18 December 2019

worksheet function - excel vba: copy rows if data match with values in column in another sheet


I have ask a related question here.
Sir Adelaide has provided me this very useful solution.


So now, in this almost similar case, I have 2 excel sheets in my workbook.
[Xsheet][1] Sheet1


I'm gonna loop through the name and description column in Sheet1 to see if it match the value in name or description column in XSheet (there might be infinite data rows in the column). If they do, then 'that' row in Sheet1 would be copied into new Sheet2.


I have modified a little bit in the previous coding (provided by Sir Adelaide),


Sub Procedure2()

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

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

'Set dat = sht.Range("code").Cells(1,1)
Set main = xsht.Range("A1")
Set dat = sht.Range("A1")
Set newdat = newsht.Range("A1")

'initialise counters
i = 1
j = 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 dat.Offset(i, 0).Value <> "" 'loop row till code data goes blank
If ((main.Offset(i, 0).Value = dat.Offset(i, 4).Value Or _
main.Offset(i, 1).Value = dat.Offset(i, 5).Value) And dat.Offset(i, 6).Value = "active") Then 'check conditions
newdat.Offset(j, 0).Value = dat.Offset(i, 0).Value 'copy code
newdat.Offset(j, 1).Value = dat.Offset(i, 2).Value 'copy title
newdat.Offset(j, 2).Value = dat.Offset(i, 3).Value 'copy date
newdat.Offset(j, 3).Value = dat.Offset(i, 4).Value 'copy name
newdat.Offset(j, 4).Value = dat.Offset(i, 5).Value 'copy descr
newdat.Offset(j, 5).Value = dat.Offset(i, 6).Value 'copy status
j = j + 1
End If

i = i + 1
Loop

Any advice provided would be appreciated. Thank you.
output Hi, I've tried to run the updated code.
This is my output, but there is an inactive case, which is not correct.
The correct output should be 4566,4987,4988.
I have go through the code, Idk what went wrong


I take away Xsheet link bcause I dont have enough reputation to make more than 2 hyperlink


I now looping through the Sheet1 to see if its match the columns in Xsheet.
4566, it matches 'Adam' in name col (since it's name or description so if name matches then it's a match), and (need to be) active, so its in.
4899, Edward is a match (or whatever description), but did not match and active, so no.
4987, same case as 4566, its Adam and active.
4988, Kris (not a match name), but al is in Xsheet's description, and active, so it's in.
4989, Chris not a match name, ttr not a match description, even its an active case (I also wont take it in)


Thank you for your guidance so far. I really appreciate it.



Answer



So after finding out what you are really doing. The question is simple:



"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".


Logical Operators : Order of precedence


Here is a revision of the code wrt your recent comment.


Sub Procedure2()

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

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

'Set dat = sht.Range("code").Cells(1,1)
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
End Sub

This revised code has FOUR changes. Added the check in the OUTER Loop to include blanks in Name field by adding Or main.Offset(i, 1).Value <> "". The change of where the information was being evaluated from i-to-i_value, to i-to-j_value, in the If statement. The addition of a third counter for data placement in the new sheet for copied data to Sheet2. And lastly, a nested loop (loop inside a loop). Loop-Outer: Looks at the Master List (xSheet) row-by-row; never repeats. Loop-Inner: Looks at the data sheet to compare top-to-bottom; repeats every new row in Master List.



You could even change the If statement to consider "active" vs. "Active", or "A" or "a". This is where a drop list comes in handy, but that's another problem in itself.


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" Or dat.Offset(j, 6).Value = "Active") Then

No comments:

Post a Comment

How can I VLOOKUP in multiple Excel documents?

I am trying to VLOOKUP reference data with around 400 seperate Excel files. Is it possible to do this in a quick way rather than doing it m...