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

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,946
Office Version
  1. 365
Platform
  1. Windows
With the test sheets you should get
1597691559904.png

and then
1597691586398.png
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,946
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Ok, with that sheet as the active sheet, run this
VBA Code:
Sub Check()
MsgBox ActiveWorkbook.Name & vbLf & "|" & ActiveSheet.Name & "|"
End Sub
What does the message box say?
 

MazExpress

Board Regular
Joined
Aug 5, 2020
Messages
53
Office Version
  1. 2010
Platform
  1. Windows
Ok, with that sheet as the active sheet, run this
VBA Code:
Sub Check()
MsgBox ActiveWorkbook.Name & vbLf & "|" & ActiveSheet.Name & "|"
End Sub
What does the message box say?
Annotation 2020-08-17 215045.jpg
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,946
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Ok, how about
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
    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

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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
56,946
Office Version
  1. 365
Platform
  1. Windows
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
VBA Code:
    Set WS1 = ThisWorkbook.Sheets("Sheet1")
is looking at the workbook containing the code, not the Aug Profit.xlsx workbook.
 

MazExpress

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

Watch MrExcel Video

Forum statistics

Threads
1,130,281
Messages
5,641,288
Members
417,202
Latest member
AndyVBA

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