I'm trying to create a macro in VBA in Excel to copy the contents of one worksheet to another (eventually will be upgraded to copying contents from one workbook to another but need to prove the concept first) but I keep encountering Run-time error '9': "Subscript out of range". The thing is, I can't see what part of the highlighted line could possibly ever be out of range.
I am using a workbook called "MetaTesting" that has 3 worksheets, and the following bit of code starts at A1 and only ever increments upwards. I have previously been able to refer to these two worksheets to be able to copy across a single row, so I know the problem isn't there. It is the fourth line of text that is being highlighted by the debugger (the line starting "Do While Trim(Application...").
Note: edited to take into account file name extension (as suggested in comments). Same error still being thrown, but now it's being thrown on line 11 (under the first comment)
Private Sub CommandButton21_Click()
Dim i As Integer, j As Integer, k As Integer
i = 1
Do While Trim(Application.Workbooks("MetaTesting.xlsm").Worksheets(3).Cells(i, 1).Value) <> ""
j = 1
Do While Trim(Application.Workbooks("MetaTesting.xlsm").Worksheets(3).Cells(1, j).Value) <> ""
'Copy cell data from one sheet to the other
Application.Workbooks("MetaTesting.xlsm").Worksheets(1).Cells(i, j).Value = Application.Workbooks("MetaTesting.xlms").Worksheets(3).Cells(i, j).Value
j = j + 1
Loop
'Copy formatting of previous row and paste it on current row. Starts at row 3, copying formatting from row 2
If i > 2 Then
k = i - 1
Application.Workbooks("MetaTesting.xlsm").Worksheets(1).Cells(k, j).Copy
Application.Workbooks("MetaTesting.xlsm").Worksheets(1).Range(Cells(i, 1), Cells(i, j)).PasteSpecial Paste:=xlPasteFormats
End If
i = i + 1
Loop
End Sub
Any and all help appreciated.
You can do this without all the loops, just copy the whole worksheet - the Copy function will handle skipping empty areas for you.
Workbooks("MetaTesting").Worksheets(1).Cells.Copy
Workbooks("MetaTesting").Worksheets(2).Cells.PasteSpecial xlPasteValues
To copy only a block of cells:
Workbooks("MetaTesting").Worksheets(1).Range("A1:M100").Copy
Workbooks("MetaTesting").Worksheets(2).Range("F12").PasteSpecial xlPasteValues ' this is the top-left corner of the paste, it'll fill in the rest
The issue on line 11 is probably due to the ("MetaTesting.xlms"). Looks like a little mistake on the file extentions; should be .xlsm like it is in the first half of the equation.
OK, now that it is determined that the workbook extension was required, let's cut your code down to what is necessary.
with Workbooks("MetaTesting.xlsm")
.Worksheets(3).Cells.Copy Destination:=.Worksheets(1).Cells
.Worksheets(1).Cells = .Worksheets(1).Cells.Value
end with
Related
My task is to use Excel to manipulate a large set of data and I had heard of using a Macro but I'm not very code-savvy. I recorded the steps that are required using the macro function, but I need to add more lines of code to utilize looping and making sure it advances by 2 after every repeat.
I've posted my steps below:
Range("A5:C5").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A5").Select
ActiveCell.FormulaR1C1 = "=R[-1]C+0.1"
Range("B7:C7").Select
Selection.Copy
Range("B5").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Basically, select 3 cells (A5:C5) insert cells and shift cells down. Use a formula in the newly empty A5 to add 0.1 to A4 and copy values from B7:C7 and paste into B5:C5.
The following image shows a before and after of what I'm talking about to make things more clear.
Before
After
The next step would be:
Range("A7:C7").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A7").Select
ActiveCell.FormulaR1C1 = "=R[-1]C+0.1"
Range("B9:C9").Select
Selection.Copy
Range("B7").Select
ActiveSheet.Paste
Application.CutCopyMode = False
and so on.
Any help with this would be greatly appreciated. I also apologize if what I'm asking is still confusing or not clear in any way.
[Prologue:]
Hi, I'll provide you with an answer and I tried to comment the heck out of it to make it as beginner friendly as possible, but the truth of the matter is:
I can explain to you how it's done, but you will never properly understand why it's done until you properly understand basic programming methodologies such as looping and that is something only you and you alone have to sit down to and fully comprehend
[The gaps in logic:]
Probably the biggest issue is, you have not specified what happens
when your data reaches empty cells (what I mean under that) - if in
your loop you were on row 10 (7, M, N) you would have no longer any
letters to add, as the next 2 rows (12) no longer contain eny data.
Given this, I modified the loop to start at the n-2th row instead to prevent this from happening (that means in your example it will end (or start to be more precise) at 6.1 as it's the last row that can retrieve the data)
In general, I'd recommend posting not only a picture of input data, but rather than picture of current result in this case a properly explained expected result would be much more to our benefit and understanding and would have saved me a lot of the guesswork here.
[The theoretical part of your question:]
I'll save you a bit of googling time here with few useful facts.
If you're looking to repeat a specific action, you should always be looking to utilize one of the 2 (or 3 depending on how you classify them) loops for and do (while/until)
Better yet, if you're looking to loop a variant amount of actions for repeated amount of times, you should utlize either a procedure Sub or a function Function so you can use arguments that act as a variable for the loop.
Generally when adding or removing rows it's important to loop from Bottom to Top (from Last to First). Why? Because if you add an extra row, it's going to mess up your Row order.
With all that in mind, the procedure itself could look something like this:
[The solution itself:]
You can use the following procedure every time for a specified range.
Option Explicit 'prevents typo. errors, undeclared variables and so on
Private Sub extra_row(ByVal rng As Range) 'declaration of procedure
Dim i As Long
' we loop for the n-th - 2 row (last row - 2) to the pre-first (added) row.
For i = (rng.Rows.Count + rng.Row - 2) To rng.Row + 1 Step -1
'why the -2? ^ Because if you add the letters from next 2 rows,_
the last 2 would have no to grab _
eg. Row 10 and 11 in your original data would have no data under them to grab
' a bit harder section to comprehend, if it's the first data entry _
we need to account for the fact that we have not added any extra rows yet_
hence we also need to decrement the row from which we receive the data by 1 _
it 's bit of difficult to word, i'd highly recommend debugging yourself _
and seeing what happens with or without it
Dim fp As Integer
If (i - 2 = rng.Rows.Count) Then
fp = 1
Else
fp = 0
End If
' now we just add the extra rows where we can
Rows(i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(i, 1) = Cells(i, 1).Offset(-1, 0) + 0.1 'we add 0.1 to cell one above
Cells(i, 2) = Cells(i + 3 - fp, 2) ' similar case, with letters, but two below
Cells(i, 3) = Cells(i + 3 - fp, 3) ' similar case, with letters, but two below
Next i 'and we loop for every cell in our specified range
End Sub
Eg. in your case, you could run the procedure with the following command:
Call extra_row(Range("A4:A11"))
[Practical use]
While the solution itself should work, in a real world example it probably might be smarter not to use a specific range to call for each procedure. Especially if that means use has to look at the worksheet, check the range and count the rows manually.
That's one of the reasons we created a procedure here to begin with. So I created one more procedure akin to main() in most programming languages which detects the last active row and applies the procedure to your data range by detecting it automatically.
So in the end, your could should look something like this:
Option Explicit
Private Sub extra_row(ByVal rng as Range)
'... code from the answer here
End Sub
Private Sub rundata()
Dim lr As Long
lr = Sheets("Your Sheet Name").Cells(Rows.Count, 1).End(xlUp).Row
'detects the last active (nonempty) row _
rememeber to change the Sheets("") to wherever your data is stored
Dim mydata As Range
Set mydata = Range("A4:A" & lr) 'under presumption your data always begins with A4
Call extra_row(mydata)
End Sub
Now, whenever you would run (manally) or Call the run_data() procedure it would automatically detect the range and apply the procedure we defined to it.
[Expected result visualization and closing words:]
We started with this:
After running the procedure:
Now I know, it may seem like there's a lot of novel concepts here, but truth of the matter is, all of them are fairly easy once you buckle down and try to comprehend the code line by line. Most of it is simple mathematical operations.
If you still have trouble comprehending anything here, do your own research first and then post comment here or better yet, create a new question (if it warrants it).
Good luck on your coding journey! :)
Rawrplus
This code should do the trick.
The code gives you an InputBox in which you can type in the number of times to run the code.
Sub test()
Application.ScreenUpdating = False
Dim Grab As Range
Dim RunTimes As Long
On Error GoTo Get_Out
RunTimes = InputBox("How many times shall the code run?", "Run times")
On Error GoTo 0
For x = 1 To RunTimes * 1.5 + 3 Step 2
Set Grab = ActiveSheet.Range("A" & x + 4)
Grab.EntireRow.Insert
Grab.Offset(-1, 0).Value = Grab.Offset(-2, 0).Value + 0.1
Grab.Offset(-1, 1).Value = Grab.Offset(1, 1).Value
Grab.Offset(-1, 2).Value = Grab.Offset(1, 2).Value
Next x
MsgBox "Succes"
Get_Out:
Application.ScreenUpdating = True
End Sub
Let me know if you have any questions about the code or if you want me to explain it further :)
I'm going to preface this by saying that I am very new to VBA and this is my first project with it however, I'm trying quite hard because otherwise it is manual copy paste ~200 times.
Unfortunately, for a first project it has been difficult.
EDITED FOR CLARITY (HOPEFULLY): The main idea is that I need to start at the beginning of a drop down list, copy the first string listed, then paste that string down the column. This changes the numerical data adjacent to the right. I then want to select this newly changed numerical data and copy and paste it to a different sheet in the same workbook in the first blank space in column F. I then want the code to iterate through the drop down list and do this for all 51 strings in the drop down. However it needs to paste offset by 3 columns for each iteration to copy the data to the correct column in the other sheet.
Here is my code thus far
Option Explicit
Sub PtComp()
'
' PtComp Macro
'
'
Dim List1 As String
Dim Range1 As Range
Dim Line1 As Range
Dim i As Integer
Dim Begin As Range
ActiveWorkbook.Sheets("Sample Data Summary").Activate
List1 = Selection
Set Range1 = Evaluate(ActiveSheet.Range(List1).Validation.Formula1)
For Each Line1 In Range1
Selection.Copy
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
ActiveCell.Offset(0, 1).Select
ActiveSheet.Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
ActiveSheet.Selection.Copy
ActiveWorkbook.Sheets("Pt Comparison").Activate
Begin = ActiveSheet.Range("F1").End(xlDown).Offset(-1, 0)
For i = 0 To 148 Step 3
Begin.Offset(0, i).Select
ActiveSheet.PasteSpecial Paste:=xlPasteValues
Next i
Next Line1
End Sub
It is highlighting this line
Set Range1 = Evaluate(ActiveSheet.Range(List1).Validation.Formula1)
Any help would be greatly appreciated. Sorry if my code is trash, like I said, first timer hoping to get better.
EDIT: Also, I looked back at older questions with the same error and thought that it was maybe because it wasn't clear what worksheet I was trying to define the range in, hence why my code is full of 'ActiveSheet' but still no luck.
Your code assumes List1 contains a valid range address, and thus that the active cell on that "Sample Data Summary" worksheet, contains a valid range address.
Apparently that isn't always the case. Search for more details on the On Error statement for ideas about how you could go about handling that situation.
You need to read up on How to avoid using Select in Excel VBA macros, and know that clipboard operations in a tight loop is pretty much the single slowest thing you can do in Excel-VBA.
Seems you want something like this:
Set Range1 = Evaluate(Selection.Validation.Formula1)
Your code blows up on Range(List1) because List1 does not contain a valid range address.
I am trying to make a check in/out system for tools. So far I have a worksheet that has a list of items that are checked out currently. Column A in that worksheet is the item number, Column B is the name, and Column C is the date and time. The macro I am trying to make is that when someone enters an the item number they want to check back IN, the macro will find that number they enter on the "Items Out" sheet, cut the entire row, and paste it to the "checkout History" sheet on the first available row. The cell that the user inputs the number they are checking in is the cell "E3" on the "Interface" worksheet. This is what I have so far.
Sub Checkin()
'
Dim targetSh As Worksheet
Dim i As Long
For i = 1 To Cells(Rows.Count, "F").End(xlUp).Row
If Cells(i, 6).value = Worksheets("Interface").Range("E3") Then
Range(Cells(i, 1), Cells(i, 6)).Copy Worksheets("Items Out").Range("A" & Worksheets("Checkout History").Cells(Rows.Count, "A").End(xlUp).Row + 1)
End If
Next i
End Sub
This doesn't work, I got this code from another post and I tried to change it to match my needs but it did not work and I could use some help here. You don't need to make the entire macro unless you really want to, I just need help finding what will make this macro work for me!
I have data on multiple sheets in a workbook that I want copied all to one sheet in that same workbook. When I run the macro, I would like it to start by deleting the current data in the "iPage Data Export" sheet and then replacing it with data from the other sheets.
I want the process to occur one column at a time since I may not bring over everything. Right now I am trying to learn how to do just one column.
I was able to get it to copy all of the contents of a column from one sheet, but when it moves to the next sheet, it overwrites the existing data. In the end, I only get one sheets worth of data copied.
Here are my 4 problems:
How do I make it clear the data on this sheet before running the routine?
How can I make it start each copy function at the bottom of that row (i.e. after the last cell with a value)? I have tried many of the suggestions on this and other boards without success. I will admit I am not very experienced in this.
How can I make it copy to a particular column (currently it just seems to default to A.
How can I concatenate multiple columns during the paste function? I.e. what if I want it to insert: A2&", "B2 instead of just A2
Sub CombineData()
Dim Sht As Worksheet
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> "iPage Data Export" Then
Sht.Select
Range("C:C").Copy
Sheets("iPage Data Export").Select
ActiveSheet.Paste
Else
End If
Next Sht
End Sub
How do I make it clear the data on this sheet before running the routine?
Sht.Cells.ClearContents
How can I make it start each copy function at the bottom of that row (i.e. after the last cell with a value)? I have tried many of the suggestions on this and other boards without success. I will admit I am not very experienced in this.
Range("C" & Rows.Count).End(xlUp).Offset(1, 0)
In detail:
Rows.Count will return the number of rows in the sheet, so in the legacy style *.xls workbooks this would return the number 65,536. Therefore "C" & Rows.Count is the same as C65536
Range("C" & Rows.Count).End(xlUp) is the same as going to C65536 and pressing Ctrl + ↑ - The command End(xlDirection) tells the program to go the last cell in that range. In this case, we would end up at the last cell containing data in column C.
.Offset(1, 0) means that we want to return the range offset by an amount of rows and/or columns. VBA uses RC (Rows Columns) references, so whenever you see something like the Offset() function with two numbers being passed as the arguments, it usually relates to the row, and the column, in that order. In this case, we want the cell that is one row below the last cell we referenced.
All-in-all the phrase Range("C" & Rows.Count).End(xlUp).Offset(1, 0) means go to the last cell in column C, go up until we hit the last cell with data, and then return the cell below that - which will be the next empty cell.
How can I make it copy to a particular column (currently it just seems to default to A.
Range("C:C").Copy Destination:=Sheets("iPage Data Export").Range("A:A")
You can pass the Destination argument in the same line and actually bypass the clipboard (faster and cleaner)
How can I concatenate multiple columns during the paste function? I.e. what if I want it to insert: A2&", "B2 instead of just A2
Lets say you wanted to reference column A, B, and F - just use:
Range("A1, B1, F1").EntireColumn
To summarise, you could streamline your existing code to something like (untested):
Sub CombineData()
Dim Sht As Worksheet
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> "iPage Data Export" Then
Sht.Range("C1:C" & Cells(Sht.Rows.Count, 3).End(xlUp).Row).Copy Destination:=Sheets("iPage Data Export").Range("A:A")
End If
Next
End Sub
This should do for the copying:
Sub CombineData()
Dim sheet As Worksheet
For Each sheet In Worksheets
If (sheet.Name <> "iPage Data Export") Then
sheet.Select
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Worksheets("iPage Data Export").Activate
Cells(1, ActiveCell.SpecialCells(xlCellTypeLastCell).Column + 1).Select
ActiveSheet.Paste
End If
Next
End Sub
For the concatenation you need to be more specific - but I guess you should open a new question with a clearer focus if you need specific help on that.
I am trying to use VBA to make my life easier but I keep getting a problem which I can't work around. Basically what I want is to copy some values from several output csv files I've got, to a nice formatted excel file. Then according to some bases numbers delete values or format the cells.
However I keep getting the same error message Run-time error '1004' application-defined or object defined error. I am doing that using many output files and pasting values at the same table file but on different sheets (10.2a, 10.2b, 10.2c, ...) by having macros for each sheet. I run all the macros in one using another macro that contains all the other macros
I looked a lot in other posts but don't understand where the error comes from. Any help would be much appreciated. The code I use for one sheet is below as an example.
Sub Table_10_2a()
'
' Copy Data from one file to another
'
Dim Output As Workbook
Dim Table As Workbook
Dim i As Integer
'Open workbooks
Set Output = Workbooks.Open("O:\...\Output.csv")
Set Table = Workbooks.Open("O:\...\Table.xlsx")
'Copy paste data from output file to Table
Output.Sheets("Output1").Range("B3:E7").Copy
Table.Sheets("10.2a").Range("B11").PasteSpecial xlValues
Output.Sheets("Output1").Range("B9:E13").Copy
Table.Sheets("10.2a").Range("B17").PasteSpecial xlValues
Output.Sheets("Output1").Range("B15:E15").Copy
Table.Sheets("10.2a").Range("B23").PasteSpecial xlValues
Output.Sheets("Output1").Range("B17:E21").Copy
Table.Sheets("10.2a").Range("B26").PasteSpecial xlValues
Output.Sheets("Output1").Range("B23:E27").Copy
Table.Sheets("10.2a").Range("B32").PasteSpecial xlValues
Output.Sheets("Output1").Range("B29:E29").Copy
Table.Sheets("10.2a").Range("B38").PasteSpecial xlValues
Output.Sheets("Output1").Range("B30:E30").Copy
Table.Sheets("10.2a").Range("B40").PasteSpecial xlValues
For i = 2 To 5
'Delete cells for values below 30
If Table.Sheets("10.2a").Cells(40, i).Value < 30 Then
Table.Sheets("10.2a").Range(Cells(26, i), Cells(36, i)).ClearContents
Table.Sheets("10.2a").Cells(38, i).NumberFormat = """[""0""]"""
Table.Sheets("10.2a").Cells(40, i).NumberFormat = """[""0""]"""
End If
'Format cells for values below 50
If Table.Sheets("10.2a").Cells(40, i).Value < 50 And Table.Sheets("10.2a").Cells(40, i).Value > 30 Then
Table.Sheets("10.2a").Range(Cells(26, i), Cells(38, i)).NumberFormat = """[""0.0""]"""
Table.Sheets("10.2a").Cells(40, i).NumberFormat = """[""0""]"""
End If
Next i
'Save file
Table.Save
'Close files
Output.Close
Table.Close
End Sub
This usage of Cells inside Range to build a block of cells commonly falls victim to an unqualified reference. In this case, you are using Table.Sheets("10.2a") to specify the sheet for Range but are not using the same qualifier on Cells. This means that Cells will use the default context available which varies with where the code is executing. Possibilities:
Inside a code module or ThisWorkbook, Cells refers to the ActiveSheet
Inside a Worksheet code behind, Cells refers to that Worksheet regardless of the ActiveSheet
Use Address to get around the different sheets
One approach is to follow the call to Cells with Address. This resolves the problem because Address returns the cell address without the sheet name. This is then interpreted by Range within its context which is Sheets("10.2a").
Range(Cells(26, i).Address, Cells(36, i).Address).ClearContents
Qualify the reference (generally preferred)
Another way to resolve this error is to qualify the reference by adding a sheet name before Cells: Table.Sheets("10.2a").Cells. Full line:
Range(Table.Sheets("10.2a").Cells(26, i), Table.Sheets("10.2a").Cells(36, i)).ClearContents
This type of code looks better within a With... End With block.