I want to edit this macro to overwrite previous data in another workbook without prompting. See attached code. Any help would be greatly appreciated.
Sub AV()
Workbooks.Open Filename:="T:\Cleveland\Avon\Monthly Sales\Monthly Sales 2018.xls"
Windows("Sales_By_Day_Location Analysis.xlsm").Activate
Sheets("AV").Select
Range("A1:AC88").Copy
Windows("Monthly Sales 2018.xls").Activate
Sheets("Avon").Select
Range("A1:D1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False 'esp
End Sub
As per comments from John, and after tidying up your code a little, I believe something like the code below would do what you are expecting:
Sub AV()
Application.DisplayAlerts = False
Workbooks.Open Filename:="T:\Cleveland\Avon\Monthly Sales\Monthly Sales 2018.xls"
Workbook("Sales_By_Day_Location Analysis.xlsm").Worksheets("AV").Range("A1:AC88").Copy
Workbook("Monthly Sales 2018.xls").Sheets("Avon").Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Application.CutCopyMode = False 'esp
Application.DisplayAlerts = True
End Sub
You should attempt not to use Activate or Select statements. Also your copy range is a lot bigger than your paste range, so for the purpose of this answer I've changed the paste range to A1.
If you want to then save the workbooks and close it without a prompt, you could do something like:
Workbook("Monthly Sales 2018.xls").Close SaveChanges:=True
Related
I have this macro that used to work nicely for a while.
I replaced seemingly irrelevant function Insert Picture for Add Shape Picture in different Sub and all sudden. It stopped working with error 1004 on line 3.
Can you advise what I have wrong there, please?
Public Sub CopyData()
ThisWorkbook.Worksheets(2).Range("C:Z").Clear
Workbooks.Open Filename:=ThisWorkbook.Path & "\Book1.xlsx"
Workbooks("Book1.xlsx").Worksheets(1).Range("A1:Z200").Copy
ThisWorkbook.Worksheets(2).Range("C1").PasteSpecial
Application.CutCopyMode = False
Workbooks("Book1.xlsx").Close SaveChanges:=False
ActiveWorkbook.Sheets(1).Activate
End Sub
The targeted sheet for Paste function was protected (locked). It works now.
hope all is well!
I posted this question on MrExcel, but thought it might gain more traction here.
I had an issue where I needed to filter the highest value, given a set.
That set was defined by rows equaling each other. For any given lat/long/timestamp I am given up to five values.
I have used a function to identify which item in each set has the highest value. This works.
The function is:
=IF(F13=MAX(IF($A:$A=A13, $F:$F)), "Yes", "No")
I would like to open each file, then run the script. So, I wrote a VBA to automate it. It worked initially, then started to freeze my unit.
I am not sure why.
I pasted a link to a test file below:
CSV Test File But also used screenshots to provide insights without downloading a file.
Notice the exact same timestamps, for each one I want the highest value.
When pressing F8 and stepping through the code, I will have the following:
Which is correct, but when I run this as a script (without stepping) the CSV file flashes infinitely.
Any help would be greatly appreciated. Code is shown below.
Sub FilterRSRP_From_CSV()
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'switching off the alert button
ActiveSheet.Name = "OriginalData"
Range("I8").Select
Selection.FormulaArray = "=IF(RC[-3]=MAX(IF(C1=RC[-8], C6)), ""Yes"", ""No"")"
Selection.AutoFill Destination:=Range("I8:I30000"), Type:=xlFillDefault
Range("I8:I30000").Select
Columns("I:I").Select
Selection.AutoFilter
ActiveSheet.Range("$I$1:$I$30000").AutoFilter Field:=1, Criteria1:="Yes"
Cells.Select
Range("L19").Activate
Selection.Copy
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "FilteredData"
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("I:I").Select
Selection.Delete Shift:=xlToLeft
Worksheets("OriginalData").Delete
ActiveWorkbook.Save
Workbooks.Close
I have cleaned up your code for you to remove the selects and turn the lights back on at the end.
Where are you running this from? A personal macro workbook or a host book? You may get an alert at the end as you are bulk closing workbooks, you would be better to specify the books, set their .Saved property to true then close them and it will surpress the alert.
Sub FilterRSRP_From_CSV()
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'switching off the alert button
ActiveSheet.Name = "OriginalData"
Range("I8").FormulaArray = "=IF(RC[-3]=MAX(IF(C1=RC[-8], C6)), ""Yes"", ""No"")"
Range("I8").AutoFill Destination:=Range("I8:I30000"), Type:=xlFillDefault
Columns("I:I").AutoFilter
ActiveSheet.Range("$I$1:$I$30000").AutoFilter Field:=1, Criteria1:="Yes"
Cells.Copy
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "FilteredData"
ActiveSheet.Paste
Columns("I:I").Delete Shift:=xlToLeft
Worksheets("OriginalData").Delete
ActiveWorkbook.Save
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Workbooks.Close
End Sub
Also what is the "alert" button you are trying to avoid with turning displayalerts off, if it is just the save then we can get around that as I explained above and not need to blanket surpress all alerts from Excel.
I have a workbook called "Data" with raw data on the "Unprocessed" sheet.
I am trying to create a sheet for every agent, called "agent" (this will be changed for every agent but for ease we will call it this for now) that pulls raw data, one row at a time, into their work area from the data workbook.
I need cells A2:M2 cut from the "Unprocessed" sheet and pasted into A4:M4 of the "agent" sheet.
I get "out of range" error. I tie this sub to a button the agents hit to bring up a new row of data.
Sub newcancel_click()
If Range("M4").Value = "EN" Then
MsgBox "You must Complete Previous cancellation.", vbCritical, "Error"
Else
Sheets("Uncompleted").Select
Range("A1:L1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Jeremy").Select
Range("B4").Select
ActiveSheet.Paste
Sheets("Uncompleted").Select
Rows("1:1").Select
Application.CutCopyMode = False
Selection.Delete
Shift:=xlUp
Sheets("Jeremy").Select
End If
End Sub
After this, I will need to create a sub to move the data from the work area to a "Processed" sheet on the "Data" book. I am comfortable that I will be able to write this sub once I get the first one working.
As for your current code, the following should work better.
Sub Newcancel_click2()
If ThisWorkbook.Sheets(1).Range("M4").Value = "EN" Then
MsgBox "You must Complete Previous cancellation.", vbCritical, "Error"
Else
Sheets("Jeremy").Range("B4:M4").Value = Sheets("Uncompleted").Range("A1:L1").Value
Sheets("Uncompleted").Rows(1).EntireRow.Delete shift:=xlUp
End If
End Sub
An interesting read for you: How to avoid using select in VBA
As for your issue, "Subscript out of range" might mean some of your ranges aren't defined properly. Your selection might not match the copy destination, or (most likely) the sheet you're referring to doesn't exist (either a typo or you've not created it yet).
To refer to another workbook you can use Workbooks("Workbook name").Sheets("Sheet name").Range etc. You can use activeworkbook to refer to the currently active workbook (not recommended as per above link to avoid using select) and you can refer to the workbook your VBA code is in with Thisworkbook, this is easier than using two statements: Workbook("Name for this one") and Workbook("Name for the other one")
In your case this would look something like:
Sub Newcancel_click2()
If ThisWorkbook.Sheets(1).Range("M4").Value = "EN" Then
MsgBox "You must Complete Previous cancellation.", vbCritical, "Error"
Else
Workbook("Agent").Sheets("Jeremy").Range("B4:M4").Value = Thisworkbook.Sheets("Uncompleted").Range("A1:L1").Value
Thisworkbook.Sheets("Uncompleted").Rows(1).EntireRow.Delete shift:=xlUp
End If
End Sub
(please note I made an approximation to most of your workbook and sheet names, please check and replace with your actual names)
Sub addinfo()
If Range("FH17") = "Unlocked" Then
Result = MsgBox("Are you sure you want to add information for a new year? (This is only to be done after you have created a new workbook for a new year)", vbYesNo + vbQuestion)
If Result = vbYes Then
Range("FH17").Value = "Locked"
'creating template
Set wk = ThisWorkbook
Dim template As String
template = Sheets("Data").Range("EW12").Value
'add template
wk.Sheets("Data").Range("A1:BC1000").Copy wk.Sheets(template).Range("A1")
'add old info
wk.Sheets("Data").Range("IE5:IK1000").Copy wk.Sheets(template).Range("A5")
wk.Sheets("Data").Range("IL5:IM1000").Copy wk.Sheets(template).Range("J5")
wk.Sheets("Data").Range("IN5:IW1000").Copy wk.Sheets(template).Range("O5")
'change date
wk.Sheets("Data").Range("EX12").Copy wk.Sheets(template).Range("E1")
'copy format to template
wk.Sheets("Data").Range("A:BC").Copy
wk.Sheets(template).Range("A1").Parent.Activate
wk.Sheets(template).Range("A1").PasteSpecial xlPasteColumnWidths
wk.Sheets(template).Range("A1").PasteSpecial xlPasteFormats
Application.CutCopyMode = False
'unhide columns
wk.Sheets(template).Range("A:BC").Select
Selection.EntireColumn.Hidden = False
'Hide columns
wk.Sheets(template).Range("AC:AD").Select
Selection.EntireColumn.Hidden = True
wk.Sheets(template).Range("AM:AN").Select
Selection.EntireColumn.Hidden = True
wk.Sheets(template).Range("AR:AT").Select
Selection.EntireColumn.Hidden = True
wk.Sheets(template).Range("A1").Select
Call rows_freeze
'Protect the sheet
ActiveSheet.Protect
MsgBox "Done."
Else
Range("FH17").Value = "Locked"
End If
End If
End Sub
This is my code, it works fine. except the part of calling on "row_freeze". I tried not having it as 2 macros but that didnt work either. I get a 400 error message. Anyone with any idea? The only part that actually needs to be fixed is the code below, I'm trying to autofit row 3 and then freeze everything above cell A4. (I tried to skip the "Rows("3:3").Select" and that did nothing)(the code works if I do it in a an new empty workbook)
Sub rows_freeze()
Rows("3:3").Select
Rows("3:3").EntireRow.AutoFit
Range("A4").Select
ActiveWindow.FreezePanes = True
End Sub
EDIT:
I format the width of the columns, I believe that it sometimes "has time" to make the columns big enough for the text to fit. but sometimes it does not and the "wrap text" causes the rows to get very long(height). I removed both lines of code(rows and freeze) and I dont get any error message (this time the rows actually did not need to be autofitted, but sometimes they do).
EDIT 2:
'copy sheet to new workbook
sheettocopy = Range("EW10").Value
Worksheets(sheettocopy).Copy
Dim wb As Workbook
'Store new workbook into a variable
Set wb = ActiveWorkbook
'Fix any macro assigned buttons
Call FixMacroLinks(wb)
'adding sheet and renaming
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = Sheets("Data").Range("EW12").Value
ActiveWorkbook.Sheets("Data").Activate
MsgBox "Done."
Else
MsgBox "You do not have a december month"
Range("FF17").Value = "Locked"
This is the code when creating the new workbook. The first thing I do when this is done, is to start the "Addinfo" sub
I have not worked with your sheet before, but I found that I was having the same problem of a 400 error while trying to autofit columns. I was able to resolve the issue when I put my code for autofitting my columns before my code for protecting my cells.
I want to paste link from one sheet to another
Range("A1:D1").Select
Range("D1").Activate
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.Paste Link:=True
However, the code would make the sheet to switch to Sheet2 from Sheet1. Is there anyway that I could paste the link without switching the sheet?
Thanks.
This will work:
ThisWorkbook.Worksheets("Sheet2").Range("D1").Formula = "=Sheet1!D1"
I guess this is what you are trying?
Sub Sample()
Dim i As Long
For i = 1 To 4
Sheets("Sheet2").Cells(1, i).Formula = "=Sheet1!" & _
Split(Cells(, i).Address, "$")(1) & "1"
Next i
End Sub
This code will do the same as your code snippet without changing the active sheet.
Range("A1:D1").Copy
Worksheets("Sheet2").Paste Link:=True
Note that this (and your code) will copy from the active sheet. If you want to copy from a sheet other than the active sheet, use somthing like
Worksheets("Sheet1").Range("A1:D1").Copy
Worksheets("Sheet2").Paste Link:=True
I've had the same problem just now. I just realized then that TightVNC was connected to another machine when I tried to run my code. When I closed it, the code run as usual.
Possibly this happens because some software might be taking control of your clipboard. Just close anything you don't need, like VNCs or Virtual Machines.
Your LINK desire cannot be done without selecting the sheet. But you can make the fact that it does that invisible to the eye.
Option Explicit
Sub test()
Application.ScreenUpdating = False
Sheets("Sheet1").Range("A1:D1").Copy
With Sheets("Sheet2")
.Activate
.Range("A1").Select
ActiveSheet.Paste Link:=True
End With
Sheets("Sheet1").Activate
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
You could use Application.ScreenUpdating = False and then return it to true after the paste has completed.
Example:
Application.ScreenUpdating = False
Worksheets("Sheet1").Range("D1").Copy
Worksheets("Sheet2").Activate
Range("Range You Want To Paste").Select
ActiveSheet.PasteSpecial Link:=True
Worksheets("Sheet1").Activate
Range("A Range You Want Active").Activate
Application.ScreenUpdating =true