The code isn't working

MazExpress

Board Regular
Joined
Aug 5, 2020
Messages
53
Office Version
  1. 2010
Platform
  1. Windows
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:

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 ??
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,950
Office Version
  1. 365
Platform
  1. Windows
What happens if you try
VBA 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(MonthName(Month(Date), 1), , 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
 

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
12,693
Office Version
  1. 365
Platform
  1. Windows
Are the months still in the same place on your actual sheet?

The code is specifically searching in row 1, so if they have been moved to row 2 then they will not be found.
 

MazExpress

Board Regular
Joined
Aug 5, 2020
Messages
53
Office Version
  1. 2010
Platform
  1. Windows
Capturenotfound.JPG

أغسطس is the name of August in Arabic.
 

MazExpress

Board Regular
Joined
Aug 5, 2020
Messages
53
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

Are the months still in the same place on your actual sheet?

The code is specifically searching in row 1, so if they have been moved to row 2 then they will not be found.
Yes, they are in the same place.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,950
Office Version
  1. 365
Platform
  1. Windows
That's why it's not working, In your actual workbook, do you have English or Arabic month names?
 

MazExpress

Board Regular
Joined
Aug 5, 2020
Messages
53
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

That's why it's not working, In your actual workbook, do you have English or Arabic month names?
English
 

jasonb75

Well-known Member
Joined
Dec 30, 2008
Messages
12,693
Office Version
  1. 365
Platform
  1. Windows
Excel doesn't translate your sheet, if your system date is in Arabic format then the code will be looking for a date in Arabic, not a date in English.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,950
Office Version
  1. 365
Platform
  1. Windows
Ok, try
Rich (BB 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
    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
 

MazExpress

Board Regular
Joined
Aug 5, 2020
Messages
53
Office Version
  1. 2010
Platform
  1. Windows
Excel doesn't translate your sheet, if your system date is in Arabic format then the code will be looking for a date in Arabic, not a date in English.
I've tried the code on another machine (Windows 10, Office 2019) with an English date format of the Windows. The same results !! No changes and no errors.
 

Watch MrExcel Video

Forum statistics

Threads
1,130,281
Messages
5,641,303
Members
417,203
Latest member
cheesegeneman

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top