I'm working on a business case with a growing number of scenarios, I could do all these in scenario manager but that's not convenient right now.
What I'm trying to do is the following: I've got a list of names for the given scenarios, these should be pasted to an input field which then runs the scenario, the results should then be copied to a location specified for that scenario.
The current code does it without any issues but it feels 'sluggish' to me because I need to make a different block of code for each scenario:
Sheets("Output").Select
Range("G7").Select
ActiveCell.FormulaR1C1 = "All stores"
Sheets("Stuurgroep").Select
Range("N4:N18").Select
Selection.Copy
Range("C4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Output").Select
Range("G7").Select
ActiveCell.FormulaR1C1 = "Quartile 1"
Sheets("Stuurgroep").Select
Range("N4:N18").Select
Selection.Copy
Range("D4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
In which G7 is the place for the scenario, "all stores" in this case is the first scenario, N4:N18 are the results of that scenario and C4 is the place for those results, with the results of the next scenario being pasted into D4.
I've tried the following code to create the list to paste into G7 but it doesn't work:
Set ListScenarios = ActiveWorkbook.Sheets("RefTables").Range("B3:B11")
For Each cell In ListScenarios
Application.CutCopyMode = False
Selection.Copy
Sheets("Output").Select
Range("G7").Select
ActiveSheet.Paste
Sheets("Stuurgroep").Select
Range("N4:N18").Select
Selection.Copy
Call Paste
Next cell
Sub Paste()
Set Destination = ActiveWorkbook.Sheets("Stuurgroep").Range("C4:K4")
For Each cell In Destination
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next cell
Help would be much appreciated!
Related
I have 2 sheets. I want to transfer a fixed range (a row of data) from sheet #1 (data sheet) to sheet #2 (info sheet) by clicking on a command button. The transferred data should be kept as records in sheet #2. But when I use the code below it overwrites the existing entry instead of adding a new record (row). How do I add a new row to sheet #2 and not overwrite the existing one?
Sheets("DATA").Select
Range("B85:G85").Select
Selection.copy
Sheets("INFO").Select
Range("B5").Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets("DATA").Select
Range("B86:G86").Select
Application.CutCopyMode = False
Selection.copy
Sheets("INFO ").Select
Range("H5").Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Problem with the Code:
No calculation of Last Row
Excessive use of Select
Try this:
With Sheets("INFO")
Sheets("DATA").Range("B85:G85").Copy
.Range("B" & .Range("B5").End(xlDown).row + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets("DATA").Range("B86:G86").Copy
.Range("H" & .Range("H5").End(xlDown).row + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
I am trying to figure this out and I am hoping you can help
Basically I have Form and Data Sheet. I am looking to copy the information in the form into a new blank row within Table1 on the data sheet,
I have managed to get as far as the following but this causes the data to be over written each time, (rather than a a new row).
Sub Macro1()
Sheets("Form").Select
Range("G5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Data").Select
Range("Table1[[#Headers],[ID]]").Select
Selection.End(xlDown).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Form").Select
Range("D3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Data").Select
Range("Table1[[#Headers],[Contact Date]]").Select
Selection.End(xlDown).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Form").Select
Range("D4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Data").Select
Range("Table1[[#Headers],[Channel]]").Select
Selection.End(xlDown).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Form").Select
Range("D5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Data").Select
Range("Table1[[#Headers],[Agent Name]]").Select
Selection.End(xlDown).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Form").Select
Range("D6").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Data").Select
Range("Table1[[#Headers],[Contact ID]]").Select
Selection.End(xlDown).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Form").Select
Range("G3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Data").Select
Range("Table1[[#Headers],[Scored by]]").Select
Selection.End(xlDown).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Form").Select
Range("G4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Data").Select
Range("Table1[[#Headers],[Team Leader]]").Select
Selection.End(xlDown).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
I realise this may seem like a simple question but I am struggling to work this out.
FYI - There will be 29 Columns to this table so If I should be doing something to make this cleaner, please let me know
Here's a more streamlined way to approach this:
EDIT - updated to add "config" array to reduce repetition
Sub Transfer()
Dim config, itm, arr
Dim rw As Range, listCols As ListColumns
Dim shtForm As Worksheet
Set shtForm = Worksheets("Form") '<< data source
With Sheets("Data").ListObjects("Table1")
Set rw = .ListRows.Add.Range 'add a new row and get its Range
Set listCols = .ListColumns 'get the columns collection
End With
'array of strings with pairs of "[colname]<>[range address]"
config = Array("ID<>G5", "Contact Date<>D3", "Channel<>D4")
'loop over each item in the config array and transfer the value to the
' appropriate column
For Each itm In config
arr = Split(itm, "<>") ' split to colname and cell address
rw.Cells(listCols(arr(0)).Index).Value = shtForm.Range(arr(1)).Value
Next itm
End Sub
No copy/paste/select/activate required.
A few times a day I receive a file. I'm trying to automate it as much as possible and one part would include having the macro that lets you select a file to vlookup into (the file name is different every time). My macro runs, but for some reason it prompts you to select your file 3 times. I've tried a few variations on the code, but nothing worked. Does anyone have any insight as to why? It is prompting once when first opening the file, once when filling in the first cell with the formula, and again when the macro fills down column with the vlookup formula. I've pasted the relevant part below:
Dim MyFile As String
MyFile = Application.GetOpenFilename
Set firstWB = ActiveWorkbook
Set mySheet = ActiveSheet
Set wbLookup = Workbooks.Open(MyFile)
firstWB.Activate
mySheet.Range("T2").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-18],'[wbLookup]tempemail'!R2C2:R123C20,19,0)"
Range("S1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown
Columns("t:t").EntireColumn.AutoFit
Columns("T:T").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
wbLookup.Close False
Range("U1").Select
ActiveCell.FormulaR1C1 = "=NOW()"
Range("U1").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("u:u").EntireColumn.AutoFit
End Sub
Thanks!
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-18],'[wbLookup]tempemail'!R2C2:R123C20,19,0)"
This will not work unless wbLookup is literally the name of your file. Excel sees this and prompts you for the actual name.
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-18],'[" & wbLookup.Name & "]tempemail'!R2C2:R123C20,19,0)"
might work better
This:
Columns("T:T").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
...could be replaced by this:
Columns("T:T").Value = Columns("T:T").Value
A lot of selecting/activating is unneeded and is better avoided: How to avoid using Select in Excel VBA
Why can´t my code below paste values only?
The result is pastes the formula instead of the value.
Can anyone help?
Please check my code as follow :
Sheets("Invoice Print").Activate
Range("F21:F27").Select
Selection.SpecialCells(xlCellTypeFormulas, 1).Select
Selection.Copy
Sheets("Outgoing Goods").Select
Cells(Rows.Count, 1).Range("K1").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveSheet.Paste
Application.CutCopyMode = False
Are there any mistakes?
PS: I'm using Excel 2013.
Please advise.
Thank you.
You overwrite the pasted values right in the next line with ActiveSheet.Paste
Also you should not use .Select and Selection..
Sheets("Invoice Print").Range("F21:F27").SpecialCells(xlCellTypeFormulas, 1).Copy
With Sheets("Outgoing Goods")
.Cells(.Rows.Count, 1).Range("K1").End(xlUp).Offset(1, 0).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'This line would overwrite the pasted values with not explecit values only
'ActiveSheet.Paste
Application.CutCopyMode = False
End With
Hope I could help.
I'm trying to rewrite someone's program, but I'm not familiar with VBA. I've tried many different ranges with .End(x1Up) and (x1Down). I understand the Up is the better option, but it just keeps pasting it in the same row every time and doesn't drop down to the next one. Here's my code (many tries have been commented out):
Sub Save_History()
Sheets("Simple Calculation").Select
Range("A10:J10").Select
Selection.Copy
'Sheets("Media Data History").Select
'Range("A65536").End(xlup).Offset(1,0)
'If Range("A1") <> "" Then
'Range("A1").End(xlUp).Offset(1, 0).Select
'End If
' Range("A1").End(xlUp).Select
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub
This should work but I encourage you to take a look at THIS Post
Sub Save_History()
Sheets("Simple Calculation").Select
Range("A10:J10").Select
Selection.Copy
Sheets("Media Data History").Select
Range("A65536").End(xlup).Offset(1,0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub
Got it!!
Sub Save_History()
Sheets("Simple Calculation").Select
Range("A10:J10").Select
Selection.Copy
Sheets("Media Data History").Select
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub