• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

copy the cell value with matching multiple criteria from two workbook sheets

AmitSingh

Member
Hi All,

I am a intermediate learner to vba programing and came up with a task to copy a cell value from workbook1 of sheet1 to workbook2 of sheet1 by matching up with multiple criteria and copy the Sort reference(workbook1) column cell value to Notes And Assumption(workbook2) cells.

Copy a cell value of column Sort Reference from workbook RMT v8.0.2 - Huawei V1.2.xlsm of Sheet Input to workbook RMT v8.0.2 - Huawei V1.2_OI-408866.xlsb of sheet MUForecasts to column Notes And Assumptions cell by matching up with multiple criteria.
Columns to match with workbook RMT v8.0.2 - Huawei V1.2.xlsm of Sheet Input to workbook RMT v8.0.2 - Huawei V1.2_OI-408866.xlsb of sheet MUForecasts are below:-
Workbook RMT v8.0.2 - Huawei V1.2.xlsm Workbook RMT v8.0.2 - Huawei V1.2_OI-408866.xlsb

RMT v8.0.2 - Huawei V1.2.xlsm --> RMT v8.0.2 - Huawei V1.2_OI-408866.xlsb
Functional Group matches with--------------------> Primary Skills

Master Role Code matches with--------------------> Master Role Code

Region/Country matches with---------------------> Work Required Country

Sort Reference(Workbook1)-----------------------> Notes And Assumptions(Workbook2)

(Note:- If all above criteria matched then matched row of column Sort Reference cell value pasted to the matched row to the column Notes And Assumptions)

I tries below code but the k value is not increasing.

Code:
Sub sortref()

Dim wbk, wbk1 As Workbook
Dim sht, sht1 As Worksheet
Dim i, j, k, n As Integer
Dim FGroup, PSkills, RegCoun, WrCoun, MRCode, RCode As String

Application.DisplayAlerts = False

Set wbk = Workbooks.Open(Filename:="C:\Users\Amit\desktop\RMT Changes\RMT v8.0.2 - Huawei V1.2.xlsm")
Workbooks("RMT v8.0.2 - Huawei V1.2.xlsm").Activate
Workbooks("RMT v8.0.2 - Huawei V1.2.xlsm").Sheets("Input").Activate

Set sht = ThisWorkbook.Worksheets("MUForecasts")

Set sht = Workbooks("RMT v8.0.2 - Huawei V1.2.xlsm").Worksheets("Input")
Set sht1 = Workbooks("RMT v8.0.2 - Huawei V1.2_OI-408866.xlsb").Worksheets("MUForecasts")

Workbooks("RMT v8.0.2 - Huawei V1.2_OI-408866.xlsb").Activate
Workbooks("RMT v8.0.2 - Huawei V1.2_OI-408866.xlsb").Sheets("MUForecasts").Activate

n = Sheets("MUForecasts").Range("A250").End(xlUp).Row

  For i = 13 To wbk.Sheets("Input").Range("C250").End(xlUp).Row
  For k = 3 To n

  'sht.Range ("H" & i)
  FGroup = sht.Range("H" & i)  '= Sheets("Input").Range("H" & i).Value
  PSkills = sht1.Range("R" & k)  '= Sheets("MUForecasts").Range("R" & k).Value

  RegCoun = sht.Range("L" & i)
  WrCoun = sht1.Range("P" & k)

  MRCode = sht.Range("X" & i)
  RCode = sht1.Range("Q" & k)

  If FGroup = PSkills Then
  If RegCoun = WrCoun Then
  If MRCode = RCode Then
  sht.Cells(i, 2).Value = sht1.Cells(k, 27).Value
  sht1.Cells(k, 27).PasteSpecial Paste:=xlPasteValues
  End If
  End If
  End If
  Next
  Next

wbk.Close
Set wbk = Nothing
Set sht = Nothing
Set sht1 = Nothing
Application.DisplayAlerts = True

End Sub
Thank you for help in advance. It would be great help.
 
Last edited by a moderator:

Hui

Excel Ninja
Staff member
Without seeing the file it may be difficult to work this out?

Have you stepped through the code and checked the variable values as you go?
You need to find out what value n is in line:
n = Sheets("MUForecasts").Range("A250").End(xlUp).Row


As an aside, you Dim lines are incorrect
You use: Dim wbk, wbk1 As Workbook
That is equivalent to
Dim wbk as Variant
Dim wbk1 As Workbook


Your line: Dim i, j, k, n As Integer
is equivalent to:
Dim i as Variant
Dim j as Variant
Dim k as Variant
Dim n as Integer

Have a read of:

https://excelmacromastery.com/vba-dim/#How_to_Use_Dim_with_Multiple_Variables
 

Hui

Excel Ninja
Staff member
Change the two lines for n & m as per below

Code:
n = sht1.Range("B" & Rows.Count).End(xlUp).Row
m = sht.Range("B" & Rows.Count).End(xlUp).Row
I then get these values for i & k, so clearly n is working

upload_2018-4-17_13-11-25.png
 
Last edited:

AmitSingh

Member
Thank you for help and it works. But there is difference in output which I was expecting. I have attached the image file of the output which I was working.
Here values get repeated when the criteria matched, but I want the row which match that should not be matched again and it read the next line.
 

Attachments

AmitSingh

Member
Here is the output of the code. Just look at the Notes & assumption column value, gets overwrite and if you see the source file, the code is picking the last value of Sort Reference column cell value of Contract Team of column Functional Group. I have attached the output result which is to be come.

Country Role Code Functional Group Notes & Assumptions
China CMCO04 Contract Team 27
China CMCO04 Contract Team 27
China CMCO04 Contract Team 27
China SVCR03 Global Service Management 28
China SVCR03 Global Service Management 28
China SVCR03 Global Service Management 28
China PMPM10 Service Delivery 15
China PMPM10 Service Delivery 15
China STST04 TDA 35
China STST04 TDA 35
India STST06 Change Management 32
India STST06 Change Management 32
India STST06 Change Management 32
India SVSO55 GCS Service Assurance 1st Line 29
India SVSO55 GCS Service Assurance 1st Line 29
India SVSO55 GCS Service Assurance 1st Line 29
India SVSO55 GCS Service Assurance 2nd Line30
India SVSO55 GCS Service Assurance 2nd Line30
India SVSO55 GCS Service Assurance 2nd Line30
India SVSO62 GCS Service Assurance Mgr Lev131
India SVSO62 GCS Service Assurance Mgr Lev131
India SVSO62 GCS Service Assurance Mgr Lev131
India STST05 Problem Management 34
India STST05 Problem Management 34
India STST05 Problem Management 34
India STST05 Service Designer 13
India PMPM11 Service Introduction 18
India PMPM11 Service Introduction 18
India SVSO55 Service Introduction 12
Malaysia CMCD10 CDSS
Malaysia CMCD10 CDSS
Malaysia PMPM10 CDSS
Malaysia PMPM10 CDSS
 

Attachments

Last edited:
Top