Okay here is my code, I'm pretty sure the error is coming from something silly in the way stuff is named. I'm just starting to learn VBA so totally noob at this and can't catch what's wrong. Any input would be appreciated.
Sub test()
Dim wsInput As Worksheet: Set wsInput = ActiveSheet
Dim wsOutput As Worksheet: Set wsOutput = Workbooks.Open("C:\output.xls").Sheets(1)
Dim OutputRowCount As Integer: OutputRowCount = 1
For i = 1 To 10000
If wsInput.Range("a12" & i) <> "" Then
wsInput.Range("D12" & i, "E12" & i).Copy
wsOutput.Range("A4" & OutputRowCount).PasteSpecial Paste:=xlPasteValues
End If
Next
End Sub
There's multiple errors/problems in your code:
Your statement wsInput.Range("a12" & i) certainly does not what you want - it'll return cells A121, A122, ..., A1210000! Instead, try wsInput.Range("A" & (12+i)) or wsInput.Range("A12").Offset(i-1). Same problem with the other ranges.
in wsInput.Range("D12" & i, "E12" & i).Copy you actually copy two cells (D12:E12, after fixing #1)- not sure you want this. If you want this, you could alternatively use the Resize method: wsInput.Range(D12).Offset(i-1).Resize(,2)
You do not increase OutputRowCount, therefore every cell will be pasted to A4 (after fix from #1, else to A41)! Add a line OutputRowCount=OutputRowCount+1.
Instead of copying and pasting, you could simply assign the .Value: wsOutputRange("A"& 4 + OutputRowCount).Resize(,2).Value = Input.Range(D12).Offset(i-1).Resize(,2).Value`
Last but not least, instead of looping over each cell, consider using .SpecialCells and Intersect, i.e. you could your whole For loop with
Application.Union( _
wsInput.Range("A4").Resize(10000).SpecialCells(xlCellTypeFormulas),
wsInput.Range("A4").Resize(10000).SpecialCells(xlCellTypeValues)) _
.Offset(,3).Resize(,2).Copy
wsOutput.Range("A4").PasteSpecial(xlPasteValues)
Hope that helps!
The maximum amount of rows you can have in Excel 32-bit is 1048576, but the last row you are trying to access here is 1210000. The below code works (all I have done is changed 10000 to 9999), but as Peter says, this probably isn't what you really want to do, unless you have some bizarre business reason or something:
Sub test()
Dim wsInput As Worksheet: Set wsInput = ActiveSheet
Dim wsOutput As Worksheet: Set wsOutput = Workbooks.Open("C:\output.xls").Sheets(1)
Dim OutputRowCount As Integer: OutputRowCount = 1
For i = 1 To 9999
If wsInput.Range("a12" & i) <> "" Then
wsInput.Range("D12" & i, "E12" & i).Copy
wsOutput.Range("A4" & OutputRowCount).PasteSpecial Paste:=xlPasteValues
End If
Next
End Sub
Error: Method 'Paste' of object '_Worksheet' failed - 1004
Solution: Need to remeber the problems in Excel before copy the shapes from one sheet to another sheet. 1. Activate the Sheet(from where you are copying). 2. Select the Shapes from Sheet. 3. Copy the shapes from the Sheet. 4. Paste to shape to target sheet
Example: Previously my code is like below:
Sheet1.Shapes(0).Copy
Targetsheet.Paste
I have modified the like below:
Sheet1.Activite
Sheet1.Shapes(0).Select
Sheet1.Shapes(0).Copy
Targetsheet.Paste
Now it is working fine.
Related
I am trying to write some code that cycles through a range of values and return either a 1 or 0. The code will only run if I select the sheet the calculation takes place in, even though I am telling the procedure that the range it is dealing with is in that sheet. I want this sheet to be very hidden as other people will use this document and I don't want them messing with the formatting. I have named the sheet in the VB as 'Binary' as well. I am still very new to VBA and am trying to learn new things about this language.
I have tried several things to fix the issue, but it breaks when I don't explicitly say to select the sheet. I've commented below in the code where it is the code breaks and I can't find a solution. Printing my debug statements give me the correct values, and the entire project runs correctly as long as I explicitly tell the procedure to select the sheet. I would prefer if there is a solution that does not require me to tell the code to hide/unhide sheets, and have the sheet remain veryhidden.
Sub Binary_Check()
Dim binaryWS As Worksheet
Dim summaryLastRow As Long
Dim summaryLastColumn As Long
Dim BinaryRng As Range
'binaryWS.Visible = xlSheetVisible
Set binaryWS = Binary
'Taking away this next line will break where I set BinaryRng
Binary.Select
summaryLastRow = binaryWS.Range("A" & Rows.Count).End(xlUp).Row
summaryLastColumn = binaryWS.Cells(1, Columns.Count).End(xlToLeft).Column
'Debug.Print summaryLastColumn
'Debug.Print summaryLastRow
'This is what breaks and gives me an error saying Method Range of object _worksheet failed
Set BinaryRng = binaryWS.Range("B2", Cells(summaryLastRow, summaryLastColumn))
'Debug.Print BinaryRng.Address
For Each cell In BinaryRng
If InStr(cell, "(") > 0 Then
cell.Value = 1
Else
cell.Value = 0
End If
Next cell
'binaryWS.Visible = xlSheetHidden
End Sub
If you use the .Cells, .Rows, .Columns method, you have to add the Worksheet reference. Otherwise it will assign an Active Worksheet to that method.
Set BinaryRng = binaryWS.Range("B2", binaryWS.Cells(summaryLastRow, summaryLastColumn))
Usually I would use the With...End With statement:
With binaryWS
summaryLastRow = .Range("A" & .Rows.Count).End(xlUp).Row
summaryLastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
'Debug.Print summaryLastColumn
'Debug.Print summaryLastRow
'This is what breaks and gives me an error saying Method Range of object _worksheet failed
Set BinaryRng = .Range("B2", .Cells(summaryLastRow, summaryLastColumn))
End With
Hello everyone i'm doing a macros code with vba, and i would like asking something, how can i write the next operation through vba macro.
Suppose you have a sheet with two columns one called "C" and the other "D" and each cell from this column has the next operation:
ws.Range("D1") = 0
ws.Range("D2") = ws.Range(C2)- ws.Range(C1)
ws.Range("D3") = ws.Range(C3)- ws.Range(C2)
...
ws.Range(Di+1) = ws.Range(Ci+1) -ws.Range(Ci)
How can i write in vba syntax an operation like:
ws.Range("D:D").FormulaR1C1 = "= R[i+1]C[""C""] - R[i]C[""C""]"
Thank you for your helping.
There are many options. See example of the code below (assuming I understood what you are after correctly)
Sub FillCells()
Dim RangeToFill As Range
Dim CurCell As Range
Dim wks As Worksheet
Set wks = ActiveSheet
Set RangeToFill = wks.Range("D2:D8") ''' define the range as required or even better - use named ranges in the so
'''' Option 1
''' youcan use R1C1 reference style for the whole range - very fast and nice solution
RangeToFill.FormulaR1C1 = "=RC[1]-R[-1]C[1]"
'''' Option 2
''' or you can use .Offset property of the range object. Note that .Address(0,0) has two zeros for the cell address not to be frozen,
''' i.e. not =$E$2 - $E$1 but =E2-E1
''' This also works but could be slower on big ranges and formula looks pretty ugly to my taste
For Each CurCell In RangeToFill.Cells
CurCell.Formula = "=" & CurCell.Offset(0, 1).Address(0, 0) & "-" & CurCell.Offset(-1, 1).Address(0, 0)
Next CurCell
End Sub
So I have a VBA that is suppose to copy the on the "data" sheet and paste it on the "Internal Use" via searching a cell on cell in the "Internal Use" I'm not getting an error it is just not doing it and it after I run the macro it just stays on the "data" sheet.
What am I missing?
Sub CommandButton2_Click()
Worksheets("Internal Use").Activate
project = Range("C4")
Worksheets("data").Activate
nr = Range("A" & Rows.Count).End(xlUp).Row
For Row = 2 To nr
If Range("F" & Row) = Worksheets("Internal Use").Range("C4") Then
Range("Q" & Row) = Worksheets("Internal Use").Range("C7")
End If
Next Row
End Sub
Hard to tell what you're trying to do. Let me know if this is what you want.
Sub CommandButton2_Click()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim nr As Long
Dim project As Variant
Set ws1 = ThisWorkbook.WorkSheets("Internal Use")
Set ws2 = ThisWorkbook.WorkSheets("data")
project = ws1.Range("C4").Value2
With ws1
nr = .Range("A" & .Rows.Count).End(xlUp).Row
For r = 2 To nr
If .Range("F" & r) = project Then
ws2.Range("Q" & r) = .Range("C7")
End If
Next
End With
End Sub
Ricardo,
Your code is working fine. Question is what are you trying to accomplish? If you are trying to paste on 'Internal Use' sheet, you need to activate it. I have added a line to activate it. Please be more specific on what you want to accomplish.
Sub CommandButton2_Click()
Worksheets("Internal Use").Activate
project = Range("C4")
Worksheets("data").Activate
nr = Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Internal Use").Activate
For Row = 2 To nr
If Range("F" & Row) = Worksheets("Internal Use").Range("C4") Then
Range("Q" & Row) = Worksheets("Internal Use").Range("C7")
End If
Next Row
End Sub
You want to populate column Q on the data sheet with the value from Worksheet Internal Use cell C7, whenever column F on the same row is equal to cell C4.
I have to say that that's easily solvable with a formula using index match or a conditional formula like =If(F2='Internal Use'!$C$4,'Internal Use'!$C$7,"") (Just paste in column F). At least this is what your code currently more or less does or seems to want to achieve.
That said let's take a look at your code:
First of all avoid .Activate, it's unnecessary overhead. This will activate the worksheet. (By the way, the last .activate you use, is on the data worksheet, hence it stays there) Next you store C4 in an undeclared variable called project that you never use.
Next you reference the cells everywhere in the loop again. This means there is huge overhead on accessing and reading out these cells. Lastly you do this in a loop; I assume this is to avoid filling up any of the other rows.
To make your code work, you could use:
Sub CommandButton2_Click()
Dim project as string
Dim writeValue as string
Dim lr as long
Dim wr as long
project = Worksheets("Internal Use").Range("C4").value
writeValue = Worksheets("data").Range("C7").value
lr = Range("A" & Rows.Count).End(xlUp).Row
With Worksheets("data")
For wr = 2 To lr
If .Range("F" & wr).value = project Then
.Range("Q" & rw).value = writeValue
End If
Next wr
End With
End Sub
This will do the trick.
Neater would be to avoid the for loop and testing all cells. Two options are putting the entire F and Q columns into arrays and loop through those simultaniously while altering the Q-array before dumping the values back in the sheet, or use a Find-algorithm such as Chip Pearons FindAll: http://www.cpearson.com/excel/findall.aspx
I'm trying to clear a certain row on the columns A:H and K in my sheet using vba.
In column K there's not only a value, also a checkbox.
I'd like to leave column I en J as they are since there's a formula in those rows.
Now I've tried a lot of different options found shattered on the internet, but can't seem to fix the problem.
My code is as following:
Sub ClearSelected()
Sheets("overview").Unprotect
Sheets("Database").Unprotect
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng As Range
Dim counter As Integer
Dim vert As Integer
Dim r As Range
Dim chkbx As CheckBox
Set ws1 = Worksheets("Overview")
Set ws2 = Worksheets("Database")
Set rng = ws1.Range("P2")
vert = rng.Value + 1
counter = 2
'do Loop
Worksheets("Database").Activate
Do While counter < vert
'if "True", remove row
If ws2.Range(ws2.Range("K" & counter)) = True Then
ws2.Range("A" & counter & ":H" & counter).Select
Selection.Clear
ws2.Range("K" & counter).Select
Selection.Clear
'Remove checkbox in selectie
Set r = Selection
For Each chkbx In ActiveSheet.CheckBoxes
If Not Intersect(r, chkbx.TopLeftCell) Is Nothing Then chkbx.Delete
Next chkbx
rng.Value = rng.Value - 1
'remove checkbox
End If
counter = counter + 1
Loop
Sheets("overview").Protect AllowUsingPivotGraphs:=True
Sheets("Database").Protect
End Sub
For some reason it's failing on the range selection/clearing.
I'm getting the errormessage 1004.
Hope you have a good suggestion for me.
I'm not entirely sure if this will work, but have you tried changing the select.clear lines to something like
ws2.Range("K" & counter).ClearContents
This clears the cells without affecting the formatting, which might possibly causing the issue. Sometimes 1004 is also down to a loss of focus on an object, or the size of the range you are trying to operate on.
BTW, you may also not need to worry too much about deleting formulas. You can re-insert them automatically.
Something like:
ws2.Range("K" & counter).FormulaR1C1="=(R+1*C+1)"
'R and C refer to row and column, so equations remain relatively referenced
The easiest way is to start recording a macro, input the desired formula into a cell, and then view the code to find out how to structure the formula in VBA.
Not sure if any of this will help, but here's hoping.
I have a rather silly problem. I have a macro (linked to a button) which copies cells A1:A2 from one worksheet (namedFP) to another worksheet (Log). I intend to copy these 2 cells on the log sheet every time I hit the macro button. The problem I am facing right now is that when I use the button multiple times, these cells are getting copied over each other instead of using the next available row to paste the cells.
This is what I have now, and I tried changing the 'Rowcount+1' to 'RowCount+2' but that did not work. Any help is appreciated.
DHRSheet.Select
Range("A1:A2").Select
Selection.Copy
LogSheet.Select
RowCount = LogSheet.UsedRange.Rows.Count
Dim r As Integer
r = RowCount + 1
Dim infocell As Range
Set infocell = Cells(r, 1)
infocell.Select
ActiveSheet.Paste
infocell.Value = DHRSheet.Name & "$" & infocell.Value
DHRSheet.Select
ActiveWorkbook.Save
Is this what you are trying?
Sub Sample()
Dim LogSheet As Worksheet, DHRSheet As Worksheet
Dim lrow As Long
'~~> Change this as applicable
Set LogSheet = Sheets("Sheet1")
Set DHRSheet = Sheets("Sheet2")
With LogSheet
lrow = LogSheet.Range("A" & .Rows.Count).End(xlUp).Row + 1
DHRSheet.Range("A1:A2").Copy .Range("A" & lrow)
End With
End Sub
Here's a function I use that is very reliable and always returns the last row of a sheet without fail:
(possibly excessive for your simple use, but I always recommend it)
Public Function LastRowOfSheet(ByVal TestSheetNumber As Variant)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Input: Sheet index # or Sheet name
' Output: Last row of sheet.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim intNumberOfRowsInWorksheet As Long
intNumberOfRowsInWorksheet = Sheets(TestSheetNumber).UsedRange.Rows.Count
intNumberOfRowsInWorksheet = intNumberOfRowsInWorksheet + Sheets(TestSheetNumber).UsedRange.Row - 1
LastRowOfSheet = intNumberOfRowsInWorksheet
End Function
And I'd clean up your above code and use something like this:
Sub Move2RowsToEnd()
Dim iNextRowOfOutput As Long
Dim iRowNumber As Long
'- use the function to find the last row of the output sheet. we'll be pasting to the first row after.
iNextRowOfOutput = (LastRowOfSheet("Log") + 1)
'- you can adjust this for loop to loop through additional cells if you need to paste more than 2 rows in the future.
For iRowNumber = 1 To 2
'- for each row of input (2 total) set the value of the output sheet equal to it.
Sheets("Log").Range("A" & iNextRowOfOutput).Value = Sheets("namedFP").Range("A" & iRowNumber).Value
iNextRowOfOutput = iNextRowOfOutput + 1
Next iRowNumber
'- not sure which of these you want to save (one or both)
Sheets("namedFP").Save
Sheets("Log").Save
End Sub
Just paste the function above or below the Subroutine and let me know if you have any issues or questions regarding the 'Move2RowsToEnd' code.