Searching for values in a column

[MazExpress]

I have a monthly sheet (Picture 1) that has 2 columns of concern, F & G. How to copy the values in column G to another workbook (Picture 2) in the column of the current month?
Knowing that:
1- The order of names in the first sheet is different from month to another.
2- Sometimes there are no names available in column F, so the corresponding values are useless.
3- Some names and values maybe unwanted (like P in Picture 1). In other words, I want to only copy the values in column G which have names in the second sheet.

Any help would be much appreciated.

 

[CA_Punit]

Book1
	A	B	C	D	E	F	G
1	Agent Name	Value		Agent Name	August
2	X	55		X	55	55
3	Y	62		Y	62	62
4	Z	25		Z	25	25
5	A	17		A	17	17
6		20		C	58	58
7	C	58		F	64	64
8	F	64
9	P	80			Using Index and Match	Using Vlookup
10
11
12
13
Sheet4

Cell Formulas
Range	Formula
E2:E7	E2	=INDEX($B$2:$B$9,MATCH(D2,$A$2:$A$9,0))
F2:F7	F2	=VLOOKUP(D2,A:B,2,0)

 

[MazExpress]

I'm so sorry. I forgot to mention that I want to build a vba code for that task to be automated.

 

[mumps]

Place the following macro in a regular module in your monthly sheet workbook. Change the name of your destination workbook (in red) and the sheet names (in blue) to suit your needs.

Sub CopyValues()
    Application.ScreenUpdating = False
    Dim Rng As Range, RngList As Object, WS1 As Worksheet, WS2 As Worksheet, Val As String, arr1 As Variant, arr2 As Variant, i As Long, fnd As Range
    Set WS1 = ThisWorkbook.Sheets("Sheet1")
    Set WS2 = Workbooks("DestinationWorkBook.xlsx").Sheets("Sheet1")
    Set fnd = WS2.Rows(1).Find(MonthName(Month(Date)))
    If Not fnd Is Nothing Then
        arr2 = WS2.Range("A2", WS2.Range("A" & WS2.Rows.Count).End(xlUp))
        arr1 = WS1.Range("F2", WS1.Range("F" & WS1.Rows.Count).End(xlUp)).Resize(, 2).Value
        Set RngList = CreateObject("Scripting.Dictionary")
        For i = LBound(arr1) To UBound(arr1)
            Val = arr1(i, 1)
            If Val <> "" Then
                RngList.Add Key:=Val, Item:=arr1(i, 2)
            End If
        Next i
        For i = LBound(arr2) To UBound(arr2)
            Val = arr2(i, 1)
            If RngList.exists(Val) Then
                WS2.Cells(i + 1, fnd.Column) = RngList(Val)
            End If
        Next i
    End If
    Application.ScreenUpdating = True
End Sub

 

[MazExpress]

Thanks a lot for your effort. I'll try it and tell you the result.

 

[MazExpress]

After changing the names of my destination workbook and sheet, I got the message "Run-time error 9 : Subscript out of range" !!

 

[mumps]

Are both workbooks open? When you click "Debug" which line of code is highlighted in yellow?

 

[MazExpress]

Yes, both are open. I've provided more images which may explain my case more clearly.
I want to copy the monthly net profits (in Picture 2) to the corresponding month (in Picture 1).

 

[mumps]

Try this revised version. In your samples in your original post, you use the full month name (August). In your last post, you use the abbreviation (Aug). I have modifed the macro to account for this (in blue). Also, for the destination workbook name you have entered the full path but it should be only the name as in the macro below (in red):

Sub CopyValues()
    Application.ScreenUpdating = False
    Dim Rng As Range, RngList As Object, WS1 As Worksheet, WS2 As Worksheet, Val As String, arr1 As Variant, arr2 As Variant, i As Long, fnd As Range
    Set WS1 = ThisWorkbook.Sheets("Sheet1")
    Set WS2 = Workbooks("Actual.xlsx").Sheets("Sheet1")
    Set fnd = WS2.Rows(1).Find(Left(MonthName(Month(Date)), 3))
    If Not fnd Is Nothing Then
        arr2 = WS2.Range("A2", WS2.Range("A" & WS2.Rows.Count).End(xlUp))
        arr1 = WS1.Range("F2", WS1.Range("F" & WS1.Rows.Count).End(xlUp)).Resize(, 2).Value
        Set RngList = CreateObject("Scripting.Dictionary")
        For i = LBound(arr1) To UBound(arr1)
            Val = arr1(i, 1)
            If Val <> "" Then
                RngList.Add Key:=Val, Item:=arr1(i, 2)
            End If
        Next i
        For i = LBound(arr2) To UBound(arr2)
            Val = arr2(i, 1)
            If RngList.exists(Val) Then
                WS2.Cells(i + 1, fnd.Column) = RngList(Val)
            End If
        Next i
    End If
    Application.ScreenUpdating = True
End Sub

 

[MazExpress]

When I ran the revised macro, nothing happened. Everything stays as it is. No changes , no bugs.