All,
I would greatly appreciate if someone could assist me with my VBA code Macro. I have 2 different Macros and I need to combine them AND alter one.
Im inserting a row via Excel at the bottom of the Table ABOVE my "Total Row". That works fine!!!
Sub InsertingRow()
Range("A" & Rows.Count).End(xlUp).Select
ActiveCell.EntireRow.Insert
End Sub
Then:
Sub Macro1()
'
' Macro1 Macro
'
'
Range("F12:O12").Select
Selection.Copy
Range("F13").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
**I need to combine the 2 Macros, but I need the PasteSpecial Macro to increment down with the Insert Row Macro and keep the specific columns/cells its copying too as well.
I have a "Total Row" so I need it to push the Total row down and insert/copy in the one above it.
Im sure this is easy.**
Thanks for all the replies.
Something like this should get you on the right track. I am not sure where your data needs to be copied from but give this a try and you will see how it works.
Sub Test()
Dim lastRow As Integer
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Rows(lastRow).Insert
Range("F" & lastRow - 1 & ":O" & lastRow - 1).Copy
Range("F" & lastRow).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
Related
Good day all
I want to use VBA to avoid the slowness in Excel when moving from one sheet to another. I replace formulas with VBA code. In brief I want to filter a column (A) that has hundreds of words based on the last characters and then use vba code to textjoin them and paste them in one cell. I managed by VBA code to filter them and paste them in another sheet but I want to edit the code to filter the list, textjoin them and paste them to a cell without using formulas. This is the code I used.
Thank you
`
Sub FilteringByLastCharacter()
Dim FLCretera As String
FLCretera = ThisWorkbook.Worksheets("Searching").Range("A2")
Sheets("WordsList").Select
Range("A1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$B12169").AutoFilter Field:=1, Criteria1:="*" & FLCretera
Columns("A:A").Select
Selection.Copy
Sheets("Searching").Select
Range("S1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("WordsList").Select
ActiveSheet.Range("$A$1:$B$12169").AutoFilter Field:=1
Sheets("Searching").Select
Range("A1").Select
Application.CutCopyMode = False
Range("A2").Select
End Sub`
application.displayalerts=false
application.screenupdating=false
FLCretera = ThisWorkbook.Worksheets("Searching").Range("A2")
Sheets("WordsList").Select
Range("A1").Select
''''clear filters
On error resume next
activesheet.clearallfilters
''''''find the las cells with inf
uf=ActiveSheet.Columns("A").Find("*", _
searchorder:=xlByRows, searchdirection:=xlPrevious).Row
''''create filter
ActiveSheet.Range("$A$1:$B" & uf).AutoFilter Field:=1, Criteria1:="*" & FLCretera
range("A1:B" & uf).copy
'''''
Sheets("Searching").Select
Range("S1").Select
Selection.PasteSpecial Paste:=xlPasteValues
for flag = 1 to uf
'''range("C" & flag) where paste the words for Cells A and B
range("C" & flag)=range("A" & flag)&range("C" & flag)
next flag
Sheets("WordsList").Select
Application.CutCopyMode = False
application.displayalerts=true
application.screenupdating=true
End Sub
sorry, my english is short, but i try to help.
take care
I am new to VBA and i tried to create i sub that will update (with vlookup and then copy paste) the comments with new comments from another sheet depending on the case status ("Open"). Basically i tried to put together a code that inserts new rows at the end of the table with a vlookup macro.
The main problem is that i do not know how to instruct excel to identify in which cell he should do the lookup and then copy and paste. As in the example below "M528" will not do it as i want to keep the records that are closed as well. I receive daily only the open cases so therefore i don`t want the code to do any vlookups in those cells where the status is "Closed"
Sub ChangesUpdates()
lastRow = Worksheets("CurrentDash").Range("A" & Rows.Count).End(xlUp).Row
For r = 2 To lastRow
If Worksheets("CurrentDash").Range("AS" & r).Value = "Open" Then
Range("M528").Select
Application.CutCopyMode = False
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=VLOOKUP([#[Parent Case Number]],NewData!C[-12]:C,13,0)"
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Without changing things too much, you can do most of what you want with
Sub ChangesUpdates()
lastRow = Worksheets("CurrentDash").Range("A" & Rows.Count).End(xlUp).Row
For rw = 2 To lastRow
If Worksheets("CurrentDash").Range("AS" & rw).Value = "Open" Then
With Worksheets("CurrentDash").Range("M" & rw)
.FormulaR1C1 = "=VLOOKUP([#[Parent Case Number]],NewData!C[-12]:C,13,0)"
.Value = .Value ' effectively a paste-values
End With
End If
Next rw
End Sub
There's no cell selection/activation here so the screen won't move to the updates, but it should cycle through the same set as your routine.
There's some remaining question in my mind about how stable the lookup area is, which you should think about.
I have a mix of codes I found that seemed to work but no longer does after changing a few things. I am trying to copy values from a range on one sheet ("Sheet1") and paste them transposed onto another ("Sheet2"). The catch is that I only want to paste them into the row that the value in column A equals the value in ("B2") on the same sheet. Also, this value will be repeated throughout column A, but I only need it to paste to the row between rows 11 and 29. Here is what I have so far:
Sub PasteData()
Range("O3:O44").Select
Selection.copy
Worksheets("Sheet2").Activate
Worksheets("Sheet2").Unprotect ("Password")
Dim nRow As Long
Dim nStart As Long, nEnd As Long
For nRow = 11 To 29
If Range("A" & nRow).Value = Range("b2").Value Then
nStart = nRow
Exit For
End If
Next nRow
For nRow = nStart To 29
If Range("a" & nRow).Value <> Range("b2").Value Then
nEnd = nRow
Exit For
End If
Next nRow
nEnd = nEnd - 1
Range("A" & nStart & ":AP" & nEnd).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Worksheets("Sheet2").Protect Password:="Password", DrawingObjects:=True, Contents:=True, Scenarios:=False
Worksheets("Sheet3").Activate
Range("B13").Select
End Sub
I have noticed on your code that you have not referenced the sheet of Range("O3:O44"). So when you run the code, it will Select and Copy the Range("O3:O44")of the active sheet.
To avoid this confusion, avoid using .Select and .Activate as much as possible especially when dealing with multiple sheets. When referencing Ranges, always include the sheet you are targeting to.
So instead of:
Range("O3:O44").Select
Selection.Copy
Do it like this:
Worksheets("Sheet1").Range("O3:O44").Copy
Now to answer your problem, you need to indicate what sheet Range("O3:O44") is from.
Then move this code on the line just before pasting it.
'range to copy with sheet reference
Worksheets("Sheet1").Range("O3:O44").Copy
'range where previous range will be pasted, also with sheet reference
Worksheets("Sheet2").Range("A" & nStart & ":AP" & nEnd).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Upon trying your code, this is the solution to the error you encounter.
I have a piece of VBA code that is taking data from a spread sheet and formatting it into an input file. This code loops through each column header to makes sure it can find the column its looking for and then offsets by one to get off of the header row and then copies the data to another template.
However this sheet is used by multiple users and the amount of rows being populated can vary so I have set up a variable called rowcount. In this example I'm working on I have 5 records and so I'm trying to select the range from the active cell to the rowcount value (5) but I'm just stuck on the following line:
ActiveSheet.Range(ActiveCell, RowCount).Select
Below is the full code for this section, I know what I'm doing is wrong but any searching via Google throws up results that are too specific and I can't tweak the code to work for me.
If ActiveCell.Value = "Account Name" Then
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value <> "" Then
ActiveSheet.Range(ActiveCell, RowCount).Select
Selection.Copy
Sheets("Input").Activate
ActiveSheet.Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Worksheets("Account Details").Select
End If
End If
For someone with more VBA knowledge I'm sure its easy but I'm essentially trying to get highlight Activecell and down to the variable so in this case A5:A10, copy, then paste.
Thanks in advance
Using Select, Activate and ActiveCell is not considered a good practice in VBA. See How to avoid using Select in Excel VBA
However, it takes time to learn to avoid these. Thus, in your code change this line:
ActiveSheet.Range(ActiveCell, RowCount).Select
To this one:
ActiveSheet.Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column)).Select
And if you have rowCount declared and set correctly, then this is a possible option:
Dim rowCount As Long: rowCount = 5
ActiveSheet.Range(ActiveCell.Column, rowCount).Select
First yours,
If ActiveCell.Value = "Account Name" Then
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value <> "" Then
ActiveCell.RESIZE(RowCount, 1).Select '<~~ resize to the # of rows
Selection.Copy
Sheets("Input").Activate
ActiveSheet.Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Worksheets("Account Details").Select
End If
End If
Now without Select, Activate or ActiveCell
dim c as variant
with worksheets("sheet1") 'you should know what worksheet you are starting out on
c = application.match("Account Name", .rows(4), 0)
if not iserror(c) then
if .cells(5, c).Value <> "" then
workSheets("Input").Range("C2").resize(RowCount, 1) = _
.cells(5, c).resize(RowCount, 1).value
end if
end if
end with
How to avoid using Select in Excel VBA
Or just use:
ActiveCell.Resize(RowCount,1).Select
Where 1 is number of columns.
At the moment in your range you have just the activecell and row number.
Try something like this:
ActiveSheet.Range(activecell.address &":" &cells(RowCount,ActiveCell.Column).address).select
Don't select the range to copy it; implementing something like this should do the job for you:
Sub Test()
Dim RNG As Range
If ActiveCell.Value = "Account Name" Then
With ActiveSheet
Set RNG = .Range(.Cells(ActiveCell.Row + 1, ActiveCell.Column), ActiveSheet.Cells(.Cells(ActiveSheet.Rows.Count, ActiveCell.Column).End(xlUp).Row, ActiveCell.Column))
End With
RNG.Copy Sheets("Input").Range("C2")
End If
End Sub
To be short and sweet with my requirement, I need a code to do the conditions below.
Select from range A2:G5
Then check if a sheet named with current date i:e 29-02-2016
If yes,
then copy paste the range in A1 leave 3 rows below for the next data to be pasted below that.
If no,
create a new sheet and name it with current date and then copy paste the range in A1 leave 3 rows below for the next data to be pasted below that.
I tried the below code but it give me error once the current date sheet is created.
Sub Macro1()
Sheets("Sheet1").Select
Range("D3:G12").Select
Selection.Copy
sheets = "todaysdate".select
Dim todaysdate As String
todaysdate = Format(Date, "dd-mm-yyyy")
AddNew:
Sheets.Add , Worksheets(Worksheets.Count)
ActiveSheet.Name = todaysdate
On Error GoTo AddNew
Sheets(todaysdate).Select
Range("A1048576").Select
Selection.End(xlUp).Select
ActiveCell.Offset(3, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End Sub
Try these modifications.
Sub Macro1()
Dim todaysdate As String
With Worksheets("Sheet1")
.Range("D3:G12").Copy
End With
todaysdate = Format(Date, "dd-mm-yyyy")
On Error GoTo AddNew
With Worksheets(todaysdate)
On Error GoTo 0
With .Cells(Rows.Count, "A").End(xlUp).Offset(3, 0)
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
End With
End With
Exit Sub
AddNew:
With Worksheets.Add(after:=Sheets(Sheets.Count))
.Name = todaysdate
With .Cells(Rows.Count, "A").End(xlUp)
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
End With
End With
End Sub
Step through the modified procedure with the [F8] key to watch how it handles the thrown error and continues on to exit or processes the paste with a three row offset.