Copy and paste data from one to other workbook base on right criteria

[tenho]

Hi!

I'm a VB Excel newbie. I have 2 workbooks:"MASTER'S LIST" and "UPDATE'S LIST" as below:


MASTER'S LIST

[pre]

STUDENT'S ID	STUDENT'S NAME	TEACHER'S NAME	DATE OF TEST	DATE OF RATING
BRTR234	        BRIAN TROBE	JOHNY WARD
SEACO451	SEASON COLIN	TRANNY COOK	11/3/2011	1/2/2012
QUASA789	QUATRON SASSY	TOM GEEK
ROSCA025	ROSSY CANDIES	WAYNNE FOX
BOBHA272	BOB HAY	        TREIWL AUS      2/1/2012        6/8/2012
WINTI614	WINHY TIN	BAYET THOON	2/1/2012	6/8/2012
COLRI991	COLLIN RINSER	GOIN BIN
BABRO614	BABARA ROIYE	LEE QUAN	11/5/2011	1/10/2012
		UPDATE'S LIST

STUDENT'S ID	STUDENT'S NAME	TEACHER'S NAME	DATE OF TEST	DATE OF RATING
COLRI991	COLLIN RINSER	GOIN BIN	2/1/2012	1/10/2012
WINTI614	WINHY TIN	BAYET THOON	2/1/2012	6/8/2012
SEACO451	SEASON COLIN	TRANNY COOK	11/3/2011	1/2/2012
QUASA789	QUATRON SASSY	TOM GEEK	11/2/2011	12/8/2012
ROSCA025	ROSSY CANDIES	WAYNNE FOX	10/6/2011	11/9/2012
BOBHA272	BOB HAY	        TREIWL AUS	2/1/2012	6/8/2012

[/pre]
Please help me built a VB macro for "UPDATE'S LIST" workbook. Click a button. It'll open the "MASTER'S LIST" copy and paste data: DATE OF TEST and DATE OF RATING of "UPDATE'S LIST" to fill the right empty cells base on: STUDENT'S ID,STUDENT'S NAME and TEACHER'S NAME, and close the "MASTER'S LIST"

Thanks in advance.

 

[bobhc]

Good day tenho


By putting "copy data to a new workbook based on criteria" in the search box many links open up, this is the first in the list


http://chandoo.org/forums/topic/all-rows-to-be-copy-in-new-worksheet-based-on-predefine-multiple-criteria

 

[tenho]

Thanks, Bobhc

I'll try to search and built VB to fit with my case.


Thanks again,

 

[kaushik03]

Hi tenho,


I am sure you will be able to solve your problem by the help of the post suggested by bobhc.


Meanwhile could you please try the below code and see if everything is fine:

[pre]

Sub DoMyWork()

Application.ScreenUpdating = False

Dim LastColumn As Integer
Dim wb As Workbook
Dim MainWB As Workbook
Dim i As Integer
Dim LstRow As Long
Dim Cntr As Long

strPath = ThisWorkbook.Path & ""
Workbooks.Open Filename:=strPath & "MASTER LIST"
'Check if source workbook is open
On Error Resume Next
Set wb = Workbooks("MASTER LIST.xlsx")
MainWB = Workbooks("UPDATE'S LIST.xlsm")

'Find the last row in Master List workbook
LstRow = wb.Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row

'Activate the Master List workbook
wb.Sheet1.Activate

'Set the initial row number
i = 2

'Start the loop to check the logic

For Cntr = 2 To LstRow

''Logic applied:

'We assume that ID number will always present in the MASTER workbook
'If the ID number is present but "DATE OF TEST" and "DATE OF RATING" are filled, copy paste from UPDATE workbook will not happen
'If the ID number is present but "DATE OF TEST" or "DATE OF RATING" are filled, macro will check if this ID ispresent in UPDATE workbook, if present then initiate the copy paste action
'If the ID number is not present, copy paste action will not happen

If Range("A" & (Cntr)).Value <> "" Then
Range("A" & (i)).Select

'Check if "DATE OF TEST" or "DATE OF RATING" is blank

If ActiveCell.Offset(0, 3).Value = "" Or ActiveCell.Offset(0, 4).Value = "" Then

'Temporarily store the value (D number) to be searched in the UPDATE workbook

TempVal = Range("A" & (Cntr)).Value

'Activate the UPDATE workbook

Workbooks("UPDATE'S LIST.xlsm").Activate

'Activate the sheet where the data is placed

Sheet1.Activate

'Take care of which may occur if the ID number not at all present in UPDATE workbook

On Error GoTo K:

'Search the ID number
SrchRslt = Application.WorksheetFunction.Match(TempVal, Range("A:A"), 0)

'Initiate the copy paste action if ID number is found

If SrchRslt > 0 Then

Range("D" & (SrchRslt), "E" & (SrchRslt)).Copy

Workbooks("MASTER LIST.xlsx").Activate
Worksheets("Sheet1").Activate
Range("D" & (Cntr)).Select
ActiveSheet.Paste

End If

End If
K:
Workbooks("MASTER LIST.xlsx").Activate
i = i + 1
'        ActiveCell.Offset(i + 1, 0).Select
End If
Next

Workbooks("MASTER LIST.xlsx").Save
Workbooks("MASTER LIST.xlsx").Close

Application.ScreenUpdating = True

End Sub

[/pre]

Instruction:


1.Download both the workbooks at your desktop


http://speedy.sh/AkP4W/ISUPDATE-S-LT.xlsm


http://speedy.sh/gW4HE/MASTER-LIST.xlsx


2.Above code is placed in UPDATE workbook. Open the UPDATE workbook(Keep the MASTER workbook closed), click on the button placed in the sheet1 (where the data is placed) of UPDATE workbook to get the MASTER workbook updated.


3. Open the MASTER workbook from your desktop and check if the data is updated properly.


Hope this helps.


Kaushik