I am writing a vba macro to allow me to reference data from a worksheet and summarize some of the data rather than using a ton of formulas to do so.
I am having difficulties in referencing worksheets and have reverted to activating sheets. I'm not sure what I am doing incorrectly. For example:
Sheets("Rainfall").Activate
Set x = Range(Range("C2"), Range("C2").End(xlDown))
rather than
Set x = Sheets("Rainfall").Range(Range("C2"), Range("C2").End(xlDown))
When I attempt to reference code such as
Cells(2 + j, 3) = Application.WorksheetFunction.VLookup(Cells(2 + j, 2), Worksheets("Raw Data").Range(Range("C4"), Range("H4").End(xlDown)), 6, False)
I get a 1004 error. Below is my code and if anyone has any suggestions on the simplification of the code that would be great as well.
Sub selectall()
Dim x, y As Range
Dim nv, rd As Long
Set Wkb = Workbooks("DWH Calculations V1.xlsm")
Sheets("Rainfall").Activate
Set x = Range(Range("C2"), Range("C2").End(xlDown))
nv = x.Rows.Count
'MsgBox (nv)
Sheets("Raw Data").Activate
Set y = Range(Range("E4"), Range("E4").End(xlDown))
rd = y.Rows.Count
'MsgBox (rd)
MinD = Round(Application.WorksheetFunction.Min(y), 0)
MaxD = Round(Application.WorksheetFunction.Max(y), 0)
Ndays = MaxD - MinD
'MsgBox (Ndays)
Sheets("Rainfall").Activate
Cells(2, 2) = MinD
For j = 1 To Ndays - 1
Cells(2 + j, 2) = Cells(1 + j, 2) + 1
Cells(2 + j, 3) = Application.WorksheetFunction.VLookup(Cells(2 + j, 2), Worksheets("Raw Data").Range(Range("C4"), Range("H4").End(xlDown)), 6, False)
Next j
End Sub
Thank you all for your help
This has been asked many times before - you need to qualify all the Range calls with a worksheet object, so:
Set x = Sheets("Rainfall").Range(Sheets("Rainfall").Range("C2"), Sheets("Rainfall").Range("C2").End(xlDown))
or use a With...End With block:
With Sheets("Rainfall")
Set x = .Range(.Range("C2"), .Range("C2").End(xlDown))
End With
and note the periods before all three Range calls. You can also use a Worksheet variable:
Dim ws as Worksheet
Set ws = Sheets("Rainfall")
Set x = ws.Range(ws.Range("C2"), ws.Range("C2").End(xlDown))
The problem is the range-within-range:
replace:
Set x = Range(Range("C2"), Range("C2").End(xlDown))
with:
With Sheets("Rainfall")
Set x = .Range(.Range("C2"), .Range("C2").End(xlDown))
End With
Activate is not needed to Set ranges.
Related
I am trying to use the below to run through values in Column A on a Sheet Named "Report" and Create these ranges in a Sheet called "Holidays_Requested" but everytime I it pops up with
Object Required Runtime error 424.
Can anyone help or know of an alternative way of creating named ranges using VBA.
Sub TransposeRange_new_code()
Dim OutRange As Range
Dim x As Long, y As Long
Dim sKey As String
Dim maxCount As Long
Dim data, dic, keys, items, dataout()
Application.ScreenUpdating = False
data = Sheets("Report").Range("A2:E" & Report.Cells(Report.Rows.Count, "A").End(xlUp).Row).Value2
Set dic = CreateObject("scripting.dictionary")
Set OutRange = Sheets("Holidays_Requested").Range("B2")
For x = 1 To UBound(data, 1)
If Trim$(data(x, 1)) <> "_" Then
sKey = Trim$(data(x, 1)) & Chr(0) & Trim$(data(x, 2))
If Not dic.exists(sKey) Then dic.Add sKey, CreateObject("Scripting.Dictionary")
dic(sKey).Add x, Array(data(x, 4), data(x, 5))
If dic(sKey).Count > maxCount Then maxCount = dic(sKey).Count
End If
Next
ReDim dataout(1 To maxCount + 1, 1 To dic.Count * 3)
keys = dic.keys
items = dic.items
For x = LBound(keys) To UBound(keys)
dataout(1, x * 3 + 1) = Split(keys(x), Chr(0))(0)
dataout(1, x * 3 + 2) = Split(keys(x), Chr(0))(1)
For y = 1 To items(x).Count
dataout(1 + y, x * 3 + 1) = items(x).items()(y - 1)(0)
dataout(1 + y, x * 3 + 2) = items(x).items()(y - 1)(1)
Next y
Next
OutRange.Resize(UBound(dataout, 1), UBound(dataout, 2)).Value2 = dataout
For x = 1 To UBound(keys)
OutRange.Offset(0, (x - 1) * 3).Resize(maxCount, 2).Name = "" & validName(Split(keys(x - 1), Chr(0))(0))
With OutRange.Offset(0, (x - 1) * 3 + 1)
.Hyperlinks.Add anchor:=.Cells(1), Address:="mailto://" & .Value2, TextToDisplay:=.Value2
End With
Next
End Sub
In your code, you're referring to a non-instantiated variable Report. Since this variable hasn't been declared with a Dim statement, it will be treated as an empty variant, zero-length string, or 0-value numeric, or a Nothing object, depending on how/when you call upon it.
And since you're doing Report.__something__ the compiler assumes it's supposed to be an Object (since only Object type have properties/methods). Since it doesn't exist and/or hasn't been assigned, you're doing essentially: Nothing.Cells...
This will always raise a 424 because in order to invoke any .__something__ call, you need to invoke it against a valid, existing Object.
Change:
data = Sheets("Report").Range("A2:E" & Report.Cells(Report.Rows.Count, "A").End(xlUp).Row).Value2
To:
With Sheets("Report")
data = .Range("A2:E" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value2
End With
As always, using Option Explicit in each module will prevent you from executing/running code with undeclared variables. I would recommend adding that statement at the top of each code module, and then rectifying any compile errors (such as Variable undefined) which might arise.
Also: See here for more reliable ways of finding the "last" cell in a given range.
And here is a VB.NET (similar conceptually) explanation of why you should be using Option Explicit.
I am looking to calculate a column (in wsOut) of averages using VBA. The input is in another sheet (wsRefor).
I use the following code, where I use the worksheet function to calculate the average
Dim Avg As Double
Dim AvgRange As Range
Set Reformulering = ActiveSheet
For i = 1 To lastCol
AvgRange = Range(wsRefor.Cells(1 + i, 4), wsRefor.Cells(1 + i, lastCol))
wsOut.Cells(i + 1, 4).Value = Application.WorksheetFunction.Average(AvgRange)
Next
Yet, I get the mistake, from the second line inside of the for-loop:
"Object variable or With block variable not set"
I am not sure I understand the error from videos I have watched and other forum discussion, so I am hoping anyone can explain or potentially point of the mistake
You need to use the Set keyword when you are assigning an object rather than a value.
A Range is an object and so it needs to be Set
Set AvgRange = Range(wsRefor.Cells(1 + i, 4), wsRefor.Cells(1 + i, lastCol))
To see the difference, you can do this:
Dim test As Variant
Range("A1").Value = "some text"
test = Range("A1") '// test is now a string containing "some text"
Set test = Range("A1") '// test is now a range object
MsgBox test.Value '// Displays the value of the range object "some text"
Assuming you defined Dim wsRefor As Worksheet, and set it to the right Sheet, then modify your line:
AvgRange = Range(wsRefor.Cells(1 + i, 4), wsRefor.Cells(1 + i, lastCol))
to:
Set AvgRange = wsRefor.Range(Cells(1 + i, 4), Cells(1 + i, lastCol))
or, on the safe side:
With wsRefor
Set AvgRange = .Range(.Cells(1 + i, 4), .Cells(1 + i, lastCol))
End With
Edit 1: full code which I've tested (also has error handling for the Average Function)
Option Explicit
Sub DynamicAvgRange()
Dim wsRefor As Worksheet
Dim wsOut As Worksheet
Dim Avg As Double
Dim AvgRange As Range
Dim lastCol As Long
Dim i As Long
Set wsRefor = ThisWorkbook.Sheets("Refor")
Set wsOut = ThisWorkbook.Sheets("Out")
' just for simulating the tests
lastCol = 6
For i = 1 To lastCol
With wsRefor
Set AvgRange = .Range(.Cells(1 + i, 4), .Cells(1 + i, lastCol))
End With
If Not IsError(Application.Average(AvgRange)) Then
wsOut.Cells(i + 1, 4).Value = Application.Average(AvgRange)
Else
' Average value returned an error (no values in the searched range)
wsOut.Cells(i + 1, 4).Value = "" ' put a blank value >> modify to your needs
End If
Next i
End Sub
I've found an interesting problem with Excel VBA's Cut and paste involving the use of a defined Range Object.
Here's the code that doesn't work:
Sub PasteToRangeDoesntWork()
Dim StRng As Range
Dim j, k, x, y As Integer
Set StRng = Range("A3")
x = 0
j = Range(StRng, StRng.End(xlToRight)).Columns.Count
k = WorksheetFunction.Max(Range(StRng, StRng.End(xlDown)))
For y = 1 To k
While StRng.Offset(x, 0) = y
x = x + 1
Wend
If y < k Then
Range(StRng.Offset(x, 0), StRng.End(xlDown).Offset(o, j - 1)).Select
Selection.Cut
Set StRng = StRng.Offset(0, j + 1)
ActiveSheet.Paste Destination:=StRng
x = 0
End If
Next y
End Sub
The problem is that when pasting to the defined StRng, the StRng object disappears and becomes and undefined object.
There's a simple fix, which I've done below.
Sub PasteToRangeWorks()
Dim StRng As Range
Dim j, k, x, y As Integer
Set StRng = Range("A3")
x = 0
j = Range(StRng, StRng.End(xlToRight)).Columns.Count
k = WorksheetFunction.Max(Range(StRng, StRng.End(xlDown)))
For y = 1 To k
While StRng.Offset(x, 0) = y
x = x + 1
Wend
If y < k Then
Range(StRng.Offset(x, 0), StRng.End(xlDown).Offset(o, j - 1)).Select
Selection.Cut
Set StRng = StRng.Offset(0, j)
ActiveSheet.Paste Destination:=StRng.Offset(0, 1)
Set StRng = StRng.Offset(0, 1)
x = 0
End If
Next y
End Sub
This works -- i.e. by not pasting the new cells directly to the StRng and instead to StRng.offset(0,1), the StRng object remains defined.
The Data in question are five columns across. The first column is an integer (with values going from 1 to 7), the next column is text followed by a column with dates and finally, two columns of general format data (2 decimal points).
The fix is not difficult but I'm perplexed as to why the first code doesn't work. Does anyone have ideas?
If you use the .Paste method, then all defined ranges that fall withing the paste boundaries will be reset. The exact "Why?" is something only Microsoft can explain I'm afraid.
A better alternative is to work with the Range.Value and Range.Clear members; these won't cause this issue, are faster, and also don't mess with the clipboard. Note however that this only copies the values and not the formatting nor any formulas.
The code for this can be something like this:
Dim SourceRng As Range
Set SourceRng = Range(StRng.Offset(x, 0), StRng.End(xlDown).Offset(0, j - 1))
Set StRng = StRng.Offset(0, j + 1)
Dim DestRng As Range
Set DestRng = StRng.Resize(SourceRng.Rows.Count, SourceRng.Columns.Count)
DestRng.Value = SourceRng.Value
Call SourceRng.Clear
You would think that this question has been answered before but I can not locate 1 person who has had to do this this way. I have Two sheets being compared for dates only on column A starting at A3. If the second sheet's Column A is missing a Date then I want it to just output that date starting at I3 of the second sheet. I feel like it is super simple but the code I have pieced together always messes up. SHEET 1
SHEET 2
If anyone wants the Code Ill gladly upload it, but I don't think it is correct at ALL.
Sub jim()
Dim CompareRange As Variant, To_Be_Compared As Variant, x As Variant, y As Variant
Range("A").Select
Selection.End(xlDown).Select
Set To_Be_Compared = Range("ALPHA!A3:" & Selection.Address)
Range("B").Select
Selection.End(xlDown).Select
Set CompareRange = Range("OUTPUT!A3:" & Selection.Address)
i = 1
To_Be_Compared.Select
For Each x In Selection
For Each y In CompareRange
If x = y Then
Range("I3" & i).Value = x
i = i + 1
End If
Next y
Next x
End Sub
Some variant arrays and dictionary objects should make quick work of isolating the orphaned dates.
Sub bert()
Dim v As Long, vALPHAs As Variant, vOUTs As Variant, dTMPs As Object, dOUTs As Object
Set dOUTs = CreateObject("Scripting.Dictionary")
Set dTMPs = CreateObject("Scripting.Dictionary")
dOUTs.CompareMode = vbTextCompare
dTMPs.CompareMode = vbTextCompare
With Worksheets("alpha")
vALPHAs = .Range(.Cells(3, 1), .Cells(Rows.Count, 1).End(xlUp).Offset(0, 1)).Value
End With
With Worksheets("output")
vOUTs = .Range(.Cells(3, 1), .Cells(Rows.Count, 1).End(xlUp)).Value
For v = LBound(vOUTs, 1) To UBound(vOUTs, 1)
If Not dOUTs.Exists(vOUTs(v, 1)) Then _
dOUTs.Add Key:=vOUTs(v, 1), Item:=vOUTs(v, 1)
Next v
For v = LBound(vALPHAs, 1) To UBound(vALPHAs, 1)
If Not dOUTs.Exists(vALPHAs(v, 1)) Then _
dTMPs.Add Key:=vALPHAs(v, 1), Item:=vALPHAs(v, 2)
Next v
If CBool(dTMPs.Count) Then
v = .Cells(Rows.Count, 9).End(xlUp).Offset(1, 0).Row
.Cells(v, 9).Resize(dTMPs.Count, 1) = Application.Transpose(dTMPs.keys)
'optionally bring across the names from column B
'.Cells(v, 10).Resize(dTMPs.Count, 1) = Application.Transpose(dTMPs.items)
End If
End With
dOUTs.RemoveAll: Set dOUTs = Nothing
dTMPs.RemoveAll: Set dTMPs = Nothing
End Sub
If you have a LOT of dates to collect, the app TRANSPOSE function might overload but that would have to be in the tens of thousands (>65,536 orphaned dates).
I want to copy a range of cells to another worksheet based on the criterion given in column N. So for each row it has to check whether or not it meets criterion in column N. If the value in Column N = 1, it should copy from that row Range(Cells(j, 1), Cells(j, 8)) to another worksheet starting at row 10. If the value in Column N = 0 it skips that row and checks the next one. So it doesn't copy that row.
Maybe my wrong code can explain it better than me:
Sub TCoutput()
Dim i As New Worksheet
Dim e As New Worksheet
Set i = ActiveWorkbook.Worksheet.Item(3)
Set e = ActiveWorkbook.Worksheets.Item(4)
Dim d
Dim j
d = 10
j = 3
Do Until IsEmpty(i.Range("N" & j))
If i.Range("N" & j) = "1" Then
d = d + 1
e.Range(Cells(d, 1), Cells(d, 8)) = i.Range(Cells(j, 1), Cells(j,8))
End If
j = j + 1
Loop
End Sub
When using multiple spreadsheets, you need to be careful and make sure all .Range and .Cells references include the worksheet you want to. First things first, replace your If statement with this one:
If i.Range("N" & j) = "1" Then
e.Range(e.Cells(d, 1), e.Cells(d, 8)) = i.Range(i.Cells(j, 1), i.Cells(j,8))
End If
Or, you can use With (which I personally prefer):
With i
If .Range("N" & j) = "1" Then
e.Range(e.Cells(d,1),e.Cells(d,8)) = .Range(.Cells(j,1),.Cells(j,8))
End If
End with
Without the explicit reference to a worksheet, the Cells() and Range() will defer to whichever one is the ActiveSheet.
try this. Ive add .value and d =d + 1
Sub TCoutput()
Dim i As New Worksheet
Dim e As New Worksheet
Set i = ActiveWorkbook.Worksheets.Item(1)
Set e = ActiveWorkbook.Worksheets.Item(2)
Dim d
Dim j
d = 10
j = 3
Do Until IsEmpty(i.Range("N" & j))
If i.Range("N" & j) = "1" Then
e.Range(e.Cells(d, 1), e.Cells(d, 8)).Value = i.Range(i.Cells(j, 1), i.Cells(j, 8)).Value
d = d + 1
End If
j = j + 1
Loop
End Sub