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
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
I am currently using the below code to add a line break to cell data in column C and copy it to column K. I need to apply line breaks to a range of data. I have 1000 rows of data in column C.
Any help will be much appreciated.
Sub Macro
Dim Stem As Variant
Stem = ThisWorkbook.Worksheets ("Sheet1").Range("C2")
Range ("K2").Select
Range("K2").FormulaR1C1 = Stem & Chr(10) & ""
End Sub
Thanks
Try this:
Sub copyAndNewLine()
'copy column C to K
Columns("C").Copy Destination:=Columns("K")
'loop through all cells in K and add new line
For i = 2 To Cells(Rows.Count, "K").End(xlUp).Row
Cells(i, "K").Value = Cells(i, "K").Value & vbCrLf
Next i
End Sub
A couple of things:
Better to early bind your variables than late (better memory
management, take advantage of intellisense, etc.)
Usually best
practice to avoid using "select" if possible.
Your Stem variable is an object (Range Object) and thus needs to be "Set"
Try this:
Sub Macro
Dim WS As Worksheet
Dim Stem As Range
Dim R2 As Range
Dim Rng as Range
Set WS = ActiveWorkbook.Sheets("Sheet1")
Set Stem = WS.Range("C2", Cells(WS.Range("C2").End(xlDown).Row, WS.Range("C2").Column))
Set R2 = WS.Range("K2", Cells(Stem.End(xlDown).Row, WS.Range("K2").Column))
R2.Value = Stem.Value
'New Code
For Each Rng In R2
Rng.Value = Rng.Value & Chr(10) & ""
Next Rng
'Old Code: R2.End(xlDown) = R2.End(xlDown) & Chr(10) & ""
End Sub
What this does is first sets the worksheet you're using. Then, you set your working range (Stem) using the Range(cell1, cell2) format. Cell1 I defined as "C2". The next expression there is using the Cells() function. It is the VBA equivalent of being in "C2" and hitting Ctl+Down, then seeing what row you're in.
Then, I set your destination range, R2, in a similar manner, but I used the Stem range to determine how large it should be.
Finally, to get an accurate copy your destination range must be the same size as your from range. The .value to .value expression pastes the data. Then, your extra characters are added on to your new data field.
Something to keep in mind with .End(xlDown)... if you have blank rows in the middle of your data it will stop there, not go all the way down to the end. Hope this helps!
EDIT:
The For Each loop will go through every range (i.e. cell) in your destination range, R2, and add your new characters. Hope that fits better for you.
Thanks to all for your answers. I atlas was able to write my first script and got the code to add line break inside the cell.
Sub AddLineBreak()
Dim Stem As Variant
Stem = ThisWorkbook.Worksheets("Sheet1").Range("C2")
Dim i As Integer
i = 2
'this will terminate the loop if an empty cell occurs in the middle of data
Do While Cells(i, "C").Value <> ""
Cells(i, "K").Value = Cells(i, "C").Value & vbCrLf
i = i + 1
Loop
End Sub
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.
I am trying to copy the value of multiple non-contiguous ranges into an array. I wrote code like this:
summaryTempArray = .range("A2:D9,A11:D12,A14:D15").Value
But it copies only the first part (A2:D9). Then, I tried the following and I get the error - "Method Union of Object _Global Failed" - is there any mistake in the way that I am using union?
summaryTempArray = Union(.range("A2:D9"), .range("A11:D12"), .range("A14:D15")).Value
Don't know what was wrong with your union, but it would have created the same range, which you stated in your first attempt.
The problem is, you have now multiple areas. Which you can, and as far as I know, has to address now.
Here is an example, which will resolve in an array of all areas, without adding each cell individually, but adding each area individually to the summary array:
Public Sub demo()
Dim summaryTempArray() As Variant
Dim i As Long
With Tabelle1
ReDim summaryTempArray(1 To .Range("A2:D9,A11:D12,A14:D15").Areas.Count)
For i = 1 To .Range("A2:D9,A11:D12,A14:D15").Areas.Count
summaryTempArray(i) = .Range("A2:D9,A11:D12,A14:D15").Areas(i)
Next i
End With
End Sub
Hope this helps.
I believe Jook's solution is as good as you are going to get if it is important to get the source ranges into an array. However, I think the solution should include instructions on extracting values from a ragged array. This is not difficult but the syntax is obscure.
I cannot get your Union statement to fail either. I assume there is something about the context that causes the failure which I cannot duplicate.
The code below shows that the two ranges are the same and that only the first sub-range is loaded to an array as you reported. It finishes with an alternative approach that might be satisfactory.
Option Explicit
Sub Test()
Dim CellValue() As Variant
Dim rng As Range
With Worksheets("Sheet1")
Set rng = .Range("A2:D9,A11:D12,A14:D15")
Debug.Print rng.Address
Set rng = Union(.Range("A2:D9"), .Range("A11:D12"), .Range("A14:D15"))
Debug.Print rng.Address
' The above debug statements show the two ranges are the same.
Debug.Print "Row count " & rng.Rows.Count
Debug.Print "Col count " & rng.Columns.Count
' These debug statements show that only the first sub-range is included the
' range counts.
CellValue = rng.Value
Debug.Print "Rows " & LBound(CellValue, 1) & " to " & UBound(CellValue, 1)
Debug.Print "Cols " & LBound(CellValue, 2) & " to " & UBound(CellValue, 2)
' As you reported only the first range is copied to the array.
rng.Copy Destination:=Worksheets("Sheet2").Range("A1")
' This shows you can copy the selected sub-ranges. If you can copy the
' required data straight to the desired destination, this might be a
' solution.
End With
End Sub
I had the same problem & tried a few methods without success until I hit on this:-
dim i as integer
Dim rng1 as range
Dim str as string
dim cels() as string
Set rng1 = sheet1.Range("A2:D9,A11:D12,A14:D15")
str = rng1.address(0,0)
cels() = split(str, ",") '<--- seems to work OK
for i = 0 to 2
Debug.Print cels(i)
Next i
I would be interested if this is an "incorrect" conversion method.
It is possible to create a multi dimensional array from non concurrent cell ranges. What I did was use a bit of the code above for the range copy mechanic I learned 2 things; that with that method you can refer to the actual cells and not just the data and you can also move and preserve order with it. In my personal project we have to use some excel files to fill out calibration data. It runs the calculations and produces a report of calibration record for our files to refer to later. These stock files are boring! I wanted to spruce it up a bit and color most of the documents empty cells depending on if the calibration passed or not. The files separate the individual check steps so the ranges I wanted to look through were not always adjacent. What I came up with is to use the copy function below to create a new sheet and paste all the non-concurrent ranges into one nice new set of concurrent ones and then have my array look at the new sheet to draw my table. I have it run the lookup I needed and then get rid of the now useless sheet.
Public Sub ColorMeCrazy()
' First Declare your variables that you will need line notes will be added to all the ones for just the array problem
Dim chkarray As Variant
Dim i As Integer ' for the array lookup loop
Dim j As Integer ' also for the array lookup loop
Dim chk1 As Boolean
Dim chk2 As Boolean
Dim cpyrange As Range ' the non-concurrent range collector haha.
Dim cz As Range
chk2 = True
Set cz = Worksheets("AN_PRM-36").Range("A1:I1,C2:I2,I3:I35,A30:H32,D33:H35,C34:C35,A36:E36,A22:H23,D24:H24,A16:H16,A8:H9,D10:H10")
' the next item below sets the ranges i wish to use. see that they arent all just right next to eachother.
Set cpyrange = Worksheets("AN_PRM-36").Range("G7:H7,G15:H15,G21:H21,G28:H29")
' this is the new sheet i made to create the array with
Sheets.Add.Name = "AN_PRM-36tmp"
' the data gets coppied to the new sheet but now its all together
cpyrange.Copy Destination:=Worksheets("AN_PRM-36tmp").Range("A1")
' now i tell the array i want it to use the data on the new sheet
chkarray = Worksheets("AN_PRM-36tmp").Range("A1:B5")
'this was my look up for the nonsense that i wanted to do later
For i = LBound(chkarray, 1) To UBound(chkarray, 1)
For j = LBound(chkarray, 2) To UBound(chkarray, 2)
Debug.Print chkarray(i, j)
If chkarray(i, j) = "Pass" Then
chk1 = True
Else
chk2 = False
End If
Next
Next
If chk1 = True And chk2 = True Then
cz.Interior.ColorIndex = 4
Else
cz.Interior.ColorIndex = 3
End If
' this last bit will get rid of the new sheet and not ask you are you sure you want it gone.
Application.DisplayAlerts = False
Sheets("AN_PRM-36tmp").Delete
Application.DisplayAlerts = True
End Sub
In Excel I have a column of words. I believe you call words "strings" in the programming world.
Row by row, I need to take each word in the column and put single inverted commas around it.
For example, if the word in the cell is dog, I need to change it to 'dog'.
I am trying to write a macro to do this, but I am already running into problems with the very first part of the vba code, which is just to import the column of words into vba from the excel spreadsheet.
My code is below. The Error message says "subscript out of range", but as you can see I have dimmed the array. What am I doing wrong? Thanks.
Sub putquotes()
Dim sym(1 To 162) As String
For i = 1 To 162
sym(i) = Worksheets("sheet1").Cells(i + 1, 1)
Next i
End Sub
I think your issue is your sheet1 name which should probably be Sheet1
I would use something like this which will run on the first worksheet (see Set ws = Sheets(1))
Note that the third sheet would be Set ws = Sheets(3), or you could use Set ws = Sheets("Sheet1") if you did have such a sheet
This code:
will run independent of the sheet that is selected
looks from the first to last used cell in column A (rather than hard-coding 162 rows)
uses variant arrays rather than ranges for speed
adds a double '' to ensure the first is visible :)
Sub PutQuotes()
Dim ws As Worksheet
Dim varList
Dim rng1 As Range
Dim lngCnt As Long
Set ws = Sheets(1)
Set rng1 = ws.Range(ws.[a1], ws.Cells(Rows.Count, "A").End(xlUp))
varList = rng1.Value2
For lngCnt = 1 To UBound(varList)
If Len(varList(lngCnt, 1)) > 0 Then _
varList(lngCnt, 1) = "''" & varList(lngCnt, 1) & "'"
Next
'dump updated array back over range
rng1.Value2 = varList
End Sub
You don't have a sheet named "Sheet1". Either:
This code lives in a standard module in the workbook with the data and you've renamed the
sheet, or
The code lives in another workbook and you haven't properly qualified your Worksheets property
I'm going to assume the latter. When you use collection properties like Worksheets or Cells, Excel makes assumptions on who the parent is. An unqualified Worksheets call in a standard module will assume
ActiveWorkbook.Worksheets()
An unqualified Worksheets call in the ThisWorkbook module will assume
ThisWorkbook.Worksheets()
To check where the problem is, add this line to your code
Debug.Print Worksheets("Sheet1").Parent.Name
That will tell you which workbook Excel is using and may be different than you want.
To avoid bad guessing, it's best to fully qualify your references. For instance, if you're opening the workbook with the data, it might look like this
Sub putquotes()
Dim wb As Workbook
Dim sym(1 To 162) As String
Dim i As Long
Set wb = Workbooks.Open("Path\Name")
For i = 1 To 162
sym(i) = wb.Sheets("Sheet1").Cells(i + 1, 1)
Next i
End Sub
Holding that wb reference is an easy way to qualify the reference. If you're not opening a separate file in code, you can just qualify explicitly like
ThisWorkbook.Worksheets("Sheet1")
ActiveWorkbook.Worksheets("Sheet1")
Workbooks("Mybook.xlsx").Worksheets("Sheet1")
A better way to read cell values into an array is like this
Sub putquotes()
Dim wb As Workbook
Dim sym As Variant
Dim i As Long
Set wb = Workbooks.Open("Path\Name")
sym = wb.Sheets("Sheet1").Range("A2").Resize(162, 1).Value
For i = LBound(sym, 1) To UBound(sym, 1)
Debug.Print "'" & sym(i, 1) & "'"
Next i
End Sub
That will give you a two-dimensional-base-1 array, which you may not like, but it's faster than reading them in one at a time.
I believe you want something like this...
Public Sub DoQuotes()
Dim iRow As Integer
Dim Result() As String
iRow = 1
Do While Not IsEmpty(Sheet1.Cells(iRow, 1))
ReDim Preserve Result(iRow - 1)
Result(iRow - 1) = "'" & Sheet1.Cells(iRow, 1) & "'"
iRow = iRow + 1
Loop
For Each x In Result
MsgBox (x)
Next x
End Sub
However, bear in mind that Excel will treat the first quote as a text delimiter so it whilst the value in the array is 'something' it will look like something' in Excel.
Just a general aside point, try to avoid calls to Worksheets() instead use the strongly typed Sheet1 object - saves all sorts of future pain if the worksheets get renamed. You can see what the sheets are "really" called in the vba editor. It will say something like Sheet1(MyWorksheet)