The code isn't working

[MazExpress]

I have a monthly sheet (Aug. Profits) that has 2 columns of concern, F & G. How to copy the values in column G to another workbook (Actual) 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. In other words, I want to only copy the values in column G which have names in the second sheet.

A very helpful member of the forum had suggested this code:

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

The code is working properly with him and fulfilling my needs. When copying the same code to a new module on my setup, it didn't work at all !! N.B Both of us are using Windows 10 and Office 2010.

Any help ??

 

[MazExpress]

Do you have any merged cells, or hidden rows?

No, I don't

 

[Fluff]

With the test sheets you should get

and then

 

[MazExpress]

With the test sheets you should get
View attachment 20546
and then
View attachment 20547

I got these 2 msg boxes instead with the test files ?.

 

[MazExpress]

View attachment 20548View attachment 20549
I got these 2 msg boxes instead with the test files ?.

 

[Fluff]

Ok, with that sheet as the active sheet, run this

Sub Check()
MsgBox ActiveWorkbook.Name & vbLf & "|" & ActiveSheet.Name & "|"
End Sub

What does the message box say?

 

[MazExpress]

Ok, with that sheet as the active sheet, run this

Sub Check()
MsgBox ActiveWorkbook.Name & vbLf & "|" & ActiveSheet.Name & "|"
End Sub

What does the message box say?

 

[Fluff]

Ok, how about

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
    Dim Mnth As String
    Set WS1 = Workbooks("Aug Profits.xlsx").Sheets("Sheet1")
    Set WS2 = Workbooks("Actual.xlsx").Sheets("Sheet1")
    Mnth = Choose(Month(Date), "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
    Set fnd = WS2.Rows(1).Find(Mnth, , xlValues, xlPart, , , False, , False)
    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")
        RngList.comparemode = 1
        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
    Else
      MsgBox "Month Not found"
    End If
    Application.ScreenUpdating = True
End Sub

 

[MazExpress]

ه

Ok, how about

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
    Dim Mnth As String
    Set WS1 = Workbooks("Aug Profits.xlsx").Sheets("Sheet1")
    Set WS2 = Workbooks("Actual.xlsx").Sheets("Sheet1")
    Mnth = Choose(Month(Date), "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
    Set fnd = WS2.Rows(1).Find(Mnth, , xlValues, xlPart, , , False, , False)
    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")
        RngList.comparemode = 1
        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
    Else
      MsgBox "Month Not found"
    End If
    Application.ScreenUpdating = True
End Sub

Finally, it worked !!!
Would you explain where the problem was please?

 

[Fluff]

The way the code was written, it needed to be in the Aug Profit workbook, but as that's an xlsx file the code must be in a different file.
So this line

    Set WS1 = ThisWorkbook.Sheets("Sheet1")

is looking at the workbook containing the code, not the Aug Profit.xlsx workbook.

 

[MazExpress]

The way the code was written, it needed to be in the Aug Profit workbook, but as that's an xlsx file the code must be in a different file.
So this line

    Set WS1 = ThisWorkbook.Sheets("Sheet1")

is looking at the workbook containing the code, not the Aug Profit.xlsx workbook.

Okkk. Thank you so much for your efforts and your time ??