Macro copies from one workbook into another, Runs with no error but sometimes doesn't work

I am slowly learning VBA in Excel on my own so I'm sure this code can be picked a part. Basically users fill this area with info and click a button that in the background copies the data they populate, opens a new workbook and pastes it in the next open row. There are many users, and for some it works, for others it runs with no error but their info is not pasted in the new. location. Most of the stuff at the end is just reformatting, but I didn't want to take it out in case it could be a part of the problem.

Function IsWorkBookOpen(FileName As String)
Dim ff As Long, ErrNo As Long

On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0

Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function


Sub FF_Temp_Upload()
'
' FF_Temp_Upload Macro
'
Application.ScreenUpdating = False
Dim Workbk As Workbook
Set Workbk = ThisWorkbook
Dim LR As Long
Dim Cell As Long
Dim Ret As String

LR = Range("B" & Rows.Count).End(xlUp).Row
Ret = IsWorkBookOpen("Location of the 2nd workbook/OVS Upload Template.xlsx")


If Ret = True Then
MsgBox "Template is currently being updated elsewhere. Please try again."
Exit Sub
Else
Workbooks.Open FileName:= _
"Location of the 2nd workbook/OVS Upload Template.xlsx"
End If

Workbk.Activate
Range("A2:C" & LR).Select
Selection.Copy
Windows("OVS Upload Template.xlsx").Activate

If Range("A2") = "" Then
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Else
Range("A1").Select
Selection.End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End If

Workbk.Activate
Range("H2:H" & LR).Select
Application.CutCopyMode = False
Selection.Copy
Windows("OVS Upload Template.xlsx").Activate

If Range("L2") = "" Then
Range("L2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Else
Range("L2").Select
Selection.End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End If

ActiveSheet.Range("$A$1:$M$100000").RemoveDuplicates Columns:=1, Header:=xlYes

LR = Range("B" & Rows.Count).End(xlUp).Row
Range("B2:B" & LR) = "=text(left(A2,8),""00000000"")"
Range("B2:B" & LR).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("C2:C" & LR) = "=""DCG""&MID(A2,9,4)"
Range("C2:C" & LR).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("D2:D" & LR).Select
Selection.Formula = "DT"
Range("I2:I" & LR).Select
Selection.Formula = "730"
Range("M2:M" & LR).Select
Selection.Formula = "MAJOH73"


ActiveWorkbook.Save
ActiveWindow.Close
Workbk.Activate

MsgBox "Articles Uploaded"
End Sub


1 Answer
1

You do not refer to Worksheets anywhere in your code. Thus, for some users, it works and for some it does not.

Worksheets

For those who works - their Excel file was saved with the correct Worksheet selected.

For those who does not work - their Excel file was saved with wrong Worksheet selected. Thus, when it is opened, the ActiveSheet is the wrong one and the code works there.

ActiveSheet

To fix it (quick and dirty) rewrite your code, refering the worksheet like this:

Worksheets("MyWorksheet").Range("$A$1:$M$100000").RemoveDuplicates Columns:=1


Then try to avoid Selection and ActiveSheet - How to avoid using Select in Excel VBA. At the end, each range or cell should be with refered Worksheet. Like this:

Selection

ActiveSheet

With Worksheets("MyName")
.Range("D2:D" & LR).Formula = "DT"
.Range("I2:I" & LR).Formula = "730"
.Range("M2:M" & LR).Formula = "MAJOH73"
End With


By clicking "Post Your Answer", you acknowledge that you have read our updated terms of service, privacy policy and cookie policy, and that your continued use of the website is subject to these policies.