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]

Ok, try

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 = ThisWorkbook.Sheets("Sheet1")
    Set WS2 = Workbooks("Actual.xlsx").Sheets("Sheet1")
    Mnth = Choose(Month(Date), "Jan", "Feb", "Mar", "Apr")
    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")
        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 MonthName(Month(Date), 1) & " Not found"
    End If
    Application.ScreenUpdating = True
End Sub

Just add the rest of the months to the list in red

N.B. It's the result of another machine, operating on Windows 10 and Office 2019.

 

[Fluff]

You've missed the " after Jul

 

[MazExpress]

You've missed the " after Jul

I'm sorry My eyes are still untrained.
After adding the " I got the same result, no changes and no errors.

 

[Fluff]

Do you get the message box saying Month name not found?

 

[MazExpress]

Do you get the message box saying Month name not found?

No

 

[Fluff]

Ok, that's a good start, what do the two messages boxes return if you run this

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
    Dim CntA As Long, CntB As Long
    Set WS1 = ThisWorkbook.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
        MsgBox "Actual rows " & UBound(arr2) & vbLf & "Aug rows " & UBound(arr1)
        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)
                CntA = CntA + 1
            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)
                CntB = CntB + 1
            End If
        Next i
    Else
      MsgBox "Month Not found"
    End If
    MsgBox "Actual " & CntB & vbLf & "Aug " & CntA
    Application.ScreenUpdating = True
End Sub

 

[MazExpress]

Ok, that's a good start, what do the two messages boxes return if you run this

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
    Dim CntA As Long, CntB As Long
    Set WS1 = ThisWorkbook.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
        MsgBox "Actual rows " & UBound(arr2) & vbLf & "Aug rows " & UBound(arr1)
        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)
                CntA = CntA + 1
            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)
                CntB = CntB + 1
            End If
        Next i
    Else
      MsgBox "Month Not found"
    End If
    MsgBox "Actual " & CntB & vbLf & "Aug " & CntA
    Application.ScreenUpdating = True
End Sub

 

[Fluff]

Ok, do you only have values in F2 & F3 of the Aug-Profits sheet & if so what are they?

 

[MazExpress]

Ok, do you only have values in F2 & F3 of the Aug-Profits sheet & if so what are they?

No, I have values from F2:F9, while F6 is empty (In the test files).

 

[Fluff]

Do you have any merged cells, or hidden rows?