I'm fairly new to VBA and i'm struggling to figure out code to copy and paste certain values to a different worksheet
I've got some code that does work, however it is very slow to run:
If CheckBox1.Value = True Then Sheets("Sheet1").Range("A2:B2").Copy Destination:=Sheets("Sheet2").Range("A2:B2")
If CheckBox2.Value = True Then Sheets("Sheet1").Range("A3:B3").Copy Destination:=Sheets("Sheet2").Range("A3:B3")
If CheckBox3.Value = True Then Sheets("Sheet1").Range("A4:B4").Copy Destination:=Sheets("Sheet2").Range("A4:B4")
...............
If CheckBox53.Value = True Then Sheets("Sheet1").Range("A54:B54").Copy Destination:=Sheets("Sheet2").Range("A54:B54")
I've got each checkbox linked to the cell next to it, e.g E2, E3, E4 etc to display True/False depending on whether is been clicked or not. Also
I'm thinking that a for loop would be better,e.g for "a=2 to 53" and use the true/false values in column E, however i'm unsure how to modify the range of cells within a for loop so that it increases just like "a", so A2:B2, A3:B3 etc
Also, the other problem with this code is that is copies the values to the same cells within the 2nd sheet. What would be the best way to get it to paste the values to the next available row.
If anyone could point out somewhere there's some similar example code that would be extremely useful so that i can learn how to do it myself.
Kind regards
Chris
edit with working code
This is the code that i've come up with to fulfill the criteria outlined above
Sub checkbox()
For i = 2 To 53
Sheets("Sheet1").Select 'activates sheet 1
If Sheets("sheet1").Cells(i, "E").Value = True Then ' checks for true value
Range("A" & i & ":B" & i).Select 'selects range of cells for copying
Selection.Copy
Sheets("Sheet2").Select 'selects sheet 2
Range("A65536").End(xlUp).Offset(1, 0).Select 'selects next available empty row
ActiveSheet.Paste 'pastes value
Else
End If
Next i
End Sub
Related
I really do believe that my VBA code has turned into a sentient entity and is doing stuff on its own even when not asked to!
Joke aside, I've been working on this code for the past week and there is something I do not understand. I first wrote this code for a previous Excel file. And it works. it does what I want it to do.
Then, I decided to use that same code for another Excel doc. The only thing that I have changed is references. I just copy/pasted the code in the new Excel file. To make it work properly, I just changed the references used by VBA to get data from the different tabs of my file.
Here's the part of the code that I have trouble with:
Dim LastRow As Long
Sheets("All").Select
Range("A3:DB50000").ClearContents
Application.Goto Reference:="Ref_EPG" 'Goes to the Ref_EPG table and selects it
If Not IsEmpty(ActiveCell.Value) Then
Selection.Copy 'Copies the Ref_EPG table
Sheets("All").Select 'Goes to the "All" tab
Range("A3").Select 'Selects cell A3
ActiveSheet.Paste 'Paste the Reference Numbs in the rows
Range("B3").Select 'Selects cell B3
Application.CutCopyMode = False 'Clears the clipboard
ActiveCell.FormulaR1C1 = _
"=IF(LEN(VLOOKUP(RC1,Table_Budget_EPG,EPG!R1C,FALSE))=0,"""",VLOOKUP(RC1,Table_Budget_EPG,EPG!R1C,FALSE))" 'Sets up the VLOOKUP function and if there is nothing in the source cell, returns blank instead of 0.
LastRow = Sheets("All").Range("A" & Rows.Count).End(xlUp).Row 'Determines the last row used in column A
If LastRow > 1 Then
Sheets("All").Range("B3").AutoFill Destination:=Sheets("All").Range("B3:B" & LastRow) 'Autofills the VLOOKUP function from B3 to the last used row of Ref_Numbers
End If
End If
The line of this code that is driving me crazy is this one:
ActiveCell.FormulaR1C1 = _
"=IF(LEN(VLOOKUP(RC1,Table_Budget_EPG,EPG!R1C,FALSE))=0,"""",VLOOKUP(RC1,Table_Budget_EPG,EPG!R1C,FALSE))" 'Sets up the VLOOKUP function and if there is nothing in the source cell, returns blank instead of 0.
This line is just supposed to insert a formula in a cell. That's all. But I don't know why, when I run the code step by step using F8, and I reach this line, it doesn't just insert the formula, it also drags it down. Which is not supposed to happen at that moment of the code.
It works perfectly in my other Excel file, why not here?
Thank you very much for your help.
Love you guys
See https://learn.microsoft.com/en-us/office/vba/api/excel.autocorrect.autofillformulasinlists
Dim autoFillTables as Boolean
'store the setting
autoFillTables = Application.AutoCorrect.AutoFillFormulasInLists
'make sure it's Off
Application.AutoCorrect.AutoFillFormulasInLists = False
'Sets up the VLOOKUP function and if there is nothing in the source cell,
' returns blank instead of 0.
ActiveCell.FormulaR1C1 = _
"=IF(LEN(VLOOKUP(RC1,Table_Budget_EPG,EPG!R1C,FALSE))=0,""""," & _
"VLOOKUP(RC1,Table_Budget_EPG,EPG!R1C,FALSE))"
'Restore the setting
Application.AutoCorrect.AutoFillFormulasInLists = autoFillTables
I created a macro that changes value in cell named "option". Once the value is changes results in the model change to reflect that.
For example:
a) Option 1: best case scenario sales -> Cell "option" input 1
b) Option 2: worst case scenario sales -> Cell "option" input 2
c) etc
The macro then copies the results from the model into a new table.
So for examples it copies the results of the model from cell named "costs" (which is dynamic cell that depends on what model spits out) to a new cell called "costs_1", which will be static.
Example of code below.
The macro works really well, however if I would want to enter 100 options then the code would be very long.
Can somebody help with how to create a general reference within the code e.g. Dim i As Integer i = i + 1, which would run until 100? that would change the cells names e.g. costs_i then it goes, costs_1, costs_2 costs_3 ... etc.
Would very much appreciate your help.
Best regards
Jan
Sub RunModel()
' RunModel Macro
....
'Choose Option 1
Range("option").Select
ActiveCell.FormulaR1C1 = "1"
'Copy costs when option 1 is selected to a new cell
[costs].Select
Selection.Copy
[costs_1].Select
Selection.PasteSpecial Paste:=xlPasteValues
'Copy number of customers when option 1 is selected to a new cell
[customers].Select
Selection.Copy
[customers_1].Select
Selection.PasteSpecial Paste:=xlPasteValues
....
etc
....
'Choose Option 2
Range("option").Select
ActiveCell.FormulaR1C1 = "2"
'Copy costs when option 2 is selected to a new cell
[costs].Select
Selection.Copy
[costs_2].Select
Selection.PasteSpecial Paste:=xlPasteValues
'Copy number of customers when option 2 is selected to a new cell
[customers].Select
Selection.Copy
[customers_2].Select
Selection.PasteSpecial Paste:=xlPasteValues
....
etc
....
Sub RunModel()
dim i as long
for i = 1 to 100 'Change this to whatever you need it to be
'No need to select and activate cells or use the clipboard, just copy the values
range("option").FormulaR1C1 = i
range("costs_" & i).value = range("costs").value
range("customers_" & i).value = range("customers").value
'Do some more stuff
next i
'Do some more stuff
end sub
First thing I did was create a button that would copy certain cells using this code:
Worksheets("Sheet1").Range("A:A,B:B,D:D").Copy _
and it worked fine.
Second, I found the code that would copy all details in a row based on the criteria of one, in this case if there was an "A" in the "Location" column.
Private Sub ENTIREROW_Click()
'Sub copyrows()
Dim i As Range, Cell As Object
Set i = Range("D:D") 'Substitute with the range which includes your True/False values
For Each Cell In i
If IsEmpty(Cell) Then
Exit Sub
End If
If Cell.Value = "A" Then
Cell.ENTIREROW.Copy
Sheet2.Select 'Substitute with your sheet
ActiveSheet.Range("A65536").End(xlUp).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
End If
Next
End Sub
My question is, how do I copy all information in the specified columns (A,B,D) where there is an "A" in "Location" in one button.
Furthermore, this is my example data, the sheet I will actually use this on has 34 columns to copy. Is there a more efficient way of setting a range when you don't want an entire sequence, everything but the data in column C?
Thanks in advance and apologies for my explanation skills.
One way maybe to:
filter your source
hide column C
copy the result using .PasteSpecial xlPasteValues into the destination
Unhide column C on the source sheet
remove the autofilter
Using xlPasteValues only pastes the visible cells from the source - so no column C
The code then looks like this: .
Sub CopyRows()
With Sheets(1).Range([A2], [A2].SpecialCells(xlLastCell))
[A1].AutoFilter
.AutoFilter Field:=4, Criteria1:="A"
[C:C].EntireColumn.Hidden = True
.Copy
[C:C].EntireColumn.Hidden = False
End With
With Sheets(2)
If .Cells(Sheets(2).Rows.Count, 1).End(xlUp) = "" Then 'it's a clean sheet
.Cells(Sheets(2).Rows.Count, 1).End(xlUp).PasteSpecial Paste:=xlPasteValues
Else
.Cells(Sheets(2).Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
End If
End With
Application.CutCopyMode = False
Sheet1.[A1].AutoFilter
End Sub
For i = 3 To 50
If lngRow = Range("A" & i) Then
Range("A1:EN3").Rows(i).Copy
Range("A1:EN3").Columns(strCol).Offset(, 1).PasteSpecial Transpose:=True
Range("A1:EN3").Rows(1).Copy
Range("A1:EN3").Columns(strCol).PasteSpecial Transpose:=True
Exit For
End If
Next i
Hello I have written code for selecting the row and paste it into column wise
it is working correctly but my problem is here i am giving range as Range("a1:en3") but every time it may be more the values than this so is it possible to copy the row data before blank cell like how we can copy the column before blank cell i,e Range(rng, rng.End(xlDown)).Copy.
Function firstblank()
i=1
While (worksheets("WORKSHEETNAMEHERE").cells(i,1).value<>"")
i=i+1
wend
return i
End function
Not totaly sure I understand your question but pasting the transposed values should be as easy as:
Range("T5").Select
Selection.PasteSpecial Transpose:=True
(i would not define a range bigger than one cell to write the values; if you give more than one cell excel will require your target to have the exact dimensions of what you are trying to write)
I have the following macro defined which inserts rows into a sheet. After the rows are inserted at specified start addresses, the various ranges are then converted into Tables. My initial thoughts are that the issue lies with the use of xlDown - since this is the place in code where rows are inserted.
At present I have 7 such ranges, however the issue is that first three always have an additional row inserted - this was previously working with no issues, so the fact that its misbehaving is a puzzle to me.
The remaining ranges are correct. The tableStartAdress refers to named ranges whose values correspond to the first cell below the green title, ie A4, A12 etc. rowsToInsert for this example is always 38.
Sub InsertTableRows(tableStartAdress As String, rowsToInsert As Integer)
Dim i As Integer
Dim rowToCopy As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.DisplayAlerts = False
Range(tableStartAdress).Offset(1, 0).Rows.Copy
rowToCopy = Range(tableStartAdress).Offset(1, 0).row & ":" & _
Range(tableStartAdress).Offset(1, 0).row
Rows(rowToCopy).Select
Selection.Copy
Range(tableStartAdress).Offset(1, 0).Select
ActiveCell.Resize(rowsToInsert, 1).Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
The following pictures depict what I mean.
Before:
.
Once data is populated the first three range/tables have an extra row
, ,
Whilst the remainder are correct
I'd suggest simplifying your code to start. (Might help you track down were things are going wrong.) Since you don't need to select a range before you do something with it....
rowToCopy = Range(tableStartAdress).Offset(1, 0).Row & _
":" & Range(tableStartAdress).Offset(1, 0).Row
Rows(rowToCopy).Select
Selection.Copy
Range(tableStartAdress).Offset(1, 0).Select
ActiveCell.Resize(rowsToInsert, 1).Select
Selection.Insert Shift:=xlDown
is the same as...
Range(tableStartAdress).Offset(1, 0).EntireRow.Copy
Range(tableStartAdress).Offset(1, 0).Resize(rowsToInsert, 1).Insert Shift:=xlDown
which is much easier to look at. A couple thoughts: First, are you sure that tableStartAddress is really always a single cell (and the correct cell)? Are you sure that rowsToInsert is always 38? Beyond that, your code as it's currently written is copying an entire row and inserting it into a range that's theoretically 38 rows by 1 column. I would recommend rewriting this so you first insert however many rows you want, then fill the 38 x 1 range with the data that belongs there.