I have lots of data (numbers) with heading in several worksheets that I am trying to zero. This is done on each column as follows: Taking the value of the first row in the column and subtracting this value from all rows in the column.
I have put together this code (may not be the best way, but Im new to VBA so :))
Dim ws As Worksheet
Dim Header As Range, Coldata As Range
Dim firstrow As Long
Dim cell As Range, cell2 As Range
Set ws = ActiveSheet
Set Header = ws.Range("B5:CJ5")
For Each cell In Header
If cell Is Nothing Then Exit For
firstrow = cell.Offset(2).Value
***Set Coldata = ws.Range(cell.offset(3),cell.Offset(3)).End(xlDown)***
cell.Value = 0
For Each cell2 In Coldata
cell2.Value = cell2.Value - firstrow
Next
Next
MsgBox "Done zeroing"
This sub is under the Module of the workbook I am working on. Whenever I run this sub from inside the VBA window it gives me the error I stated in the description on the Line of the code with **** around it.
When I try to run it from a workhsheet it says Cannot run the macro. The macro may not be avaiable in this worksheet or all macros may be disabled. The thing is I run another macro in the same module it works, so macros being disabled is out of the question.
What am I missing?
Thanks in advance!
Edit, I fixed it.. But running it takes SO much time? Excel freezes when I run it though?
You are over-specifying. Replace:
Set Coldata = ws.Range(cell.Offset(3)).End(xlDown)
with:
Set Coldata = cell.Offset(3).End(xlDown)
cell is fully qualified already.
Related
I am attempting to Copy values in a Row, one by one from each cell, then use those values as worksheet names, one by one. One of the issues I had was skipping the first batch of sheets, so I attempted to hide the ones I don't want renamed. All other sheets should be renamed (34 of them).
I can get it all the way "ws.PasteSpecial xlPasteValues" using F8 before I get an error message that says "Run-time error '1004'L Method 'PasteSpecial' of object'_Worksheet' failed.
I have also tried using "Activesheet.PasteSpecial xlPasteValues" but it gave the same error.
Any suggestions at all are very much appreciated, this is driving me nuts. :) My back up plan is simply using the macro record and doing every rename manually, but it's not a very elegant or simple code that way, so I'd prefer not to do that.
Here is the Code:
Dim ws As Worksheet
Dim TitleID As String
Dim TID As String
Sheets("SheetName1").Activate
Set ws = ActiveSheet
Dim rng As Range, cell As Range
Set rng = ws.Range("C5", "AJ5")
For Each cell In rng
cell.Copy
Sheets("SheetName1").Visible = False
ws.Next.Select
ws.PasteSpecial xlPasteValues
Next cell
If I understand your question, properly, the below code should work.
Dim ws As Worksheet
Set ws = Sheets("SheetName1")
Dim rng As Range, cell As Range
Set rng = ws.Range("C5","AJ5")
Dim i as Integer
i = 5 'this is an arbitrary number, change to whatever number of worksheets
'you wish to exclude that are at the beginning (left most side) of your workbook
'also assumes "SheetName1" is before this number.
For Each cell In rng
Sheets(i).Name = cell.Value
i = i + 1
Next cell
I'm using microsoft excel 2013.
So i have two sheets. "Cases" and "Summarize". All of my important info is on the Cases sheet. Is there way i can be on the "Summarize" sheet, push a button and copy all the cellrows with the value "RLH" from cases over to the summarize sheet?
I've filled the entire row up to N. And i want that entire row to be copied into the summarize sheet when I push the button. The "RLH" value is on the N(last) column.
I know how to create the button and how to insert the code. I've been googling my ass of, but I cant seem to find anything that fits me.
All help is greatly appreciated.
Here is very simple. that will get you started
assign to Button
Option Explicit
Sub Mybutton()
'// declare a variable
Dim cRng As Range
Dim rngA As Long
Dim rngB As Long
Dim Cols As Long
Dim sCases As Worksheet
Dim sSummarize As Worksheet
'// Set the sheets name
Set sCases = Sheets("Cases")
Set sSummarize = Sheets("Summarize")
'// goes through each cell in Sheets"Cases"
'// and copes the Value "RLH" to Sheets"Summarize"
'// it starts from last row in column A & looks up
rngA = sCases.Cells(Rows.Count, "N").End(xlUp).Row
Cols = sCases.UsedRange.Columns.Count
For Each cRng In sCases.Range("A2:A" & rngA)
If cRng.Value = "RLH" Then '<<<<<<<<< Value = "RLT"
rngB = sSummarize.Cells(Rows.Count, "A").End(xlUp).Row + 1
sSummarize.Range("A" & rngB).Resize(1, Cols) = cRng.Resize(1, Cols).Value
End If
'// loop
Next cRng
Set sSummarize = Nothing
Set sCases = Nothing
End Sub
hope this helps
you may also find help full on the following link MSDN Getting Started with VBA.
Okay, so I am relatively new to Excel VBA. I am trying to do something which seems quite simple to me and there are many, many examples of how to do it which I have read exhaustively but I cannot seem to get past this so...here goes.
I am trying to paste a range of cells from one worksheet to another in Excel Microsoft Office Professional Plus 2010. I think I have reduced the problem to the absolute simplest form possible to illustrate the problem. This is just a snippet. The VictimResults and TempWorksheet variables are set higher up. I didn't include the code because I thought it might confuse the articulation of the problem.
Dim SourceWorksheet As Worksheet
Dim TargetWorksheet As Worksheet
Dim SourceRange As Range
Dim TargetRange As Range
Set SourceWorksheet = VictimResults
Set TargetWorksheet = TempWorksheet
Set SourceRange = Cells(1, 1)
Set TargetRange = Cells(1, 1)
TargetWorksheet.Range(TargetRange) = SourceWorksheet.Range(SourceRange)
I have placed the variables SourceWorksheet, TargetWorksheet, SourceRange, and TargetRange in a watch and set a breakpoint at the last line and they are all valid objects (not null). When I step over the breakpoint I get a dialog box which simply says "400".
Any help is much appreciated.
---edit---
I have created this complete VBA file that replicates the problem. Thought that might help someone answer.
Option Explicit
Sub Main()
GetFirstWorksheetContainsName("Sheet1").Range(Cells(1, 1)).Value = GetFirstWorksheetContainsName("Sheet2").Range(Cells(1, 1)).Value
End Sub
Function GetFirstWorksheetContainsName(worksheetNameContains) As Worksheet
Dim m As Long
Dim result As Worksheet
m = 1
Do
If InStr(1, Sheets(m).Name, worksheetNameContains) Then
Set result = Sheets(m)
Exit Do
End If
m = m + 1
Loop Until m > ThisWorkbook.Worksheets.Count
Set GetFirstWorksheetContainsName = result
End Function
Here is something else I tried which yields something a little more verbose.
Option Explicit
Sub Main()
Sheets("Sheet1").Select
Range(Cells(1, 1)).Select
Selection.Copy
Sheets("Sheet2").Select
Range(Cells(1, 1)).Select
ActiveSheet.Paste
End Sub
It gives me a "Method 'Range' of object '_Global' failed" error when executing the first Range(Cells(1, 1)).Select line.
If you are trying to copy and paste why not use .copy and .pastespecial. They may slow down your code a little bit but as long as your aren't copying and pasting thousands of things it should be ok.
I'm not sure where the 400 is coming from, but the exception that is thrown is the same is in your verbose example (1004 - "Method 'Range' of object '_Worksheet' failed", and is thrown for the same reason.
The problem is how you're addressing the Range. Cells(1, 1) is implicitly set to the active worksheet, not whatever range you are passing it to as a parameter. Since you only need one cell, you can just use the .Cells property instead:
Sub Main()
GetFirstWorksheetContainsName("Sheet1").Cells(1, 1).Value = _
GetFirstWorksheetContainsName("Sheet2").Cells(1, 1).Value
End Sub
If you need to copy more than one cell, you'll have to either grab a reference to a worksheets instead of inlining the calls to GetFirstWorksheetContainsName if you use dynamic ranges:
Sub Main()
Dim source As Worksheet
Dim data As Range
Set source = GetFirstWorksheetContainsName("Sheet2")
Set data = source.Range("A1:B2")
GetFirstWorksheetContainsName("Sheet1").Range(data.Address).Value = data.Value
End Sub
Or hard code it:
Sub Main()
GetFirstWorksheetContainsName("Sheet1").Range("A1:B2").Value = _
GetFirstWorksheetContainsName("Sheet2").Range("A1:B2").Value
End Sub
Suppose in a worksheet the formula of R4 cell is =B1+B2, and its current value is 10.
A VBA command Range("R4").Value = 5 will change both its formula and its value to 5.
Does anyone know if there exists a VBA command which changes the value of R4 to 5, but does not change its formula, such that its formula is still =B1+B2?
PS: we can also achieve the same state in another way: 1) do a Range("R4").Value = 5 2) change the formula of R4 to =B1+B2 but without evaluating it. In this case, does there exist a VBA command which change the formula of a cell without evaluating it?
Edit: What I want to do is...
I would like to write a function, which takes a worksheet where some cells may be out of date (the formula does not match its value), and generates automatically a VBA Sub, this VBA Sub can reproduce this worksheet. The VBA Sub may look like:
Sub Initiate()
Cells(2,3).Value = 5
Cells(4,5).Value = 10
...
Cells(2,3).Formula = "=2+3"
Cells(4,5).Formula = "=C2+C2"
...
End Sub
Such that running Initiate() builds one worksheet with same values and formulas.
Without the VBA command I am asking, this Initiate() will be hard to generated.
You cannot change the value of a cell to something different than what the cell formula computes to.
Regarding your p.s.: You can probably change the formula of a cell without re-evaluation by changing the calculation mode to manual. But that would of course apply to the entire workbook, not just this one cell
EDIT: maybe a solution would be to temporarily save the formula of the cell in either a tag of that cell, or a hidden worksheet?
It is quite simple to change the result of a formula without changing the formula itself:
Change the value of of its argument(s). This is a Solver-type approach:
Sub ForceDesiredResult()
Dim r As Range
Set r = Range("B2")
With r
If r.HasFormula Then
.Formula = .Formula & "-5"
Else
.Value = .Value - 5
End If
End With
End Sub
Here is some very dirty code that will save all values of all formulas on the active sheet as custom properties of the sheet, and a 2nd sub that will mark red all cells where the value has changed from it's original value, while preserving all formulas. It will need some error-checking routines (property already exists, property doesn't exist,...) but should give you something to work with. Since I don't really understand your problem it's a bit hard to say ;)
Sub AddCustomProperty()
Dim mysheet As Worksheet
Dim mycell2 As Range
Dim myProperty As CustomProperty
Set mysheet = ActiveWorkbook.ActiveSheet
For Each objcell In mysheet.UsedRange.Cells
Debug.Print objcell.Address
If objcell.HasFormula Then Set myProperty = mysheet.CustomProperties.Add(objcell.Address, objcell.Value)
Next objcell
End Sub
Sub CompareTags()
Dim mysheet As Worksheet
Dim mycell2 As Range
Dim myProperty As CustomProperty
Set mysheet = ActiveWorkbook.ActiveSheet
For Each objcell In mysheet.UsedRange.Cells
Debug.Print objcell.Address
If objcell.HasFormula Then
On Error Resume Next
If mysheet.CustomProperties(objcell.Address).Value <> objcell.Value Then
objcell.Font.ColorIndex = 3
On Error GoTo 0
End If
End If
Next objcell
End Sub
The following VBA code (Excel 2007) is failing with Error 1004, "Autofill Method of Range Class Failed.". Can anyone tell me how to fix it?
Dim src As Range, out As Range, wks As Worksheet
Set wks = Me
Set out = wks.Range("B:U")
Set src = wks.Range("A6")
src.AutoFill Destination:=out
(note: I have Googled, etc. for this. It comes up fairly often, but all of the responses that I saw had to do with malformed range addresses, which AFAIK is not my problem.
At someone's suggestion I tried replacing the autofill line with the following:
src.Copy out
This had the effect of throwing my Excel session into an apparent infinite loop consuming 100% CPU and then just hanging forever.
OK, apparently the source has to be part of the destination range for autofill. So my code now looks like this:
Dim src As Range, out As Range, wks As Worksheet
Set wks = Me
Set out = wks.Range("B1")
Set src = wks.Range("A6")
src.Copy out
Set out = wks.Range("B:U")
Set src = wks.Range("B1")
src.AutoFill Destination:=out, Type:=xlFillCopy
Same error on the last line.
From MSDN:
The destination must include the
source range.
B:U does not contain A6 and thus there is an error. I believe that you probably want out to be set to A6:U6.
Specifiying just the column name means that you want to fill every row in that column which is unlikely to be the desired behvaiour
Update
Further to the OP's comment below and update to the original answer, this might do the trick:
Dim src As Range, out As Range, wks As Worksheet
Set wks = Me
Set out = wks.Range("B1")
Set src = wks.Range("A6")
src.Copy out
Set out = wks.Range("B1:U1")
Set src = wks.Range("B1")
src.AutoFill Destination:=out, Type:=xlFillCopy
Set out = wks.Range("B:U")
Set src = wks.Range("B1:U1")
src.AutoFill Destination:=out, Type:=xlFillCopy
AutoFill is constrained to a single direction (i.e. horizontal or vertical) at once. To fill a two-dimensional area from a single cell you first have to auto-fill a line along one edge of that area and then stretch that line across the area
For the specific case of copying the formatting and clearing the contents (by virtue of the source cell being empty), this is better:
Dim src As Range, out As Range, wks As Worksheet
Set wks = Sheet1
Set out = wks.Range("B:U")
Set src = wks.Range("A6")
src.Copy out
To make AutoFill work, you need to make the range of AutoFill more than the source range. If the AutoFill range is same as of Source range then there is nothing to AutoFill in that range and hence you would get an error
1004: AutoFill method of Range class failed.
So make AutoFill range more than the source range and error will gone.
If you want to autofill you just do something like...
Private Sub Autofill()
'Select the cell which has the value you want to autofill
Range("Q2").Select
'Do an autofill down to the amount of values returned by the update
Selection.AutoFill Destination:=Range("Q2:Q10")
End Sub
This would autofill down to the specified range.
Does ths help?
Not sure if this helps anyone, but I needed something similar. Selecting the cells as destination works;
dim rowcount as integer
Sheets("IssueTemplate").Select ' Whatever your sheet is
rowcount = 0
rowcount = Application.CountA(Range("A:A"))'get end range
Cells(4, 3).Select 'select the start cell
'autofill to rowcount
Selection.AutoFill Destination:=Range("C4:C" & rowcount), Type:=xlFillDefault
in my example I had to auto-generate a list of folder names from OA100 to OA###?, and this worked fine.