Problems trying to set RefersToRange property in Excel VBA - excel

I was helping a friend work out a problem with VBA in Excel 2007 today, and we ran into an issue I think I'd encountered and worked around in the past. It's an issue with changing the range to which a name refers.
On my friend's main worksheet, in B7, she has data validation from a List where the Source is a named range, CAT_LOOKUP. She wanted to run a sub that would filter a table on another worksheet to show only rows that correspond to the value in B7 and then use those rows as the source for validation in another cell on that worksheet.
Here's the relevant part of the VBA we were using:
Dim strCAT As String
Dim strACT As String
Dim sh As Worksheet
Dim rng As Range
Dim rngDest As Range
If Cells(7, 2) <> "" Then
strCAT = Cells(7, 2).Value
Sheets("CAT LOOKUP").Range("$A2:$C393").AutoFilter Field:=1, _
Criteria1:=strCAT
Set sh = Sheets("CAT LOOKUP")
Set rng = sh.Range("B34:B56")
rng.ClearContents
Set rng = sh.Range(sh.Range("B1"), sh.Range("B1").End(xlDown))
rng.Copy
Set rngDest = sh.Range("B34")
rngDest.PasteSpecial
ActiveWorkbook.Names("CAT_LOOKUP").RefersToRange = _
sh.Range(sh.Range("B35"), sh.Range("B35").End(xlDown))
Else
Set sh = Sheets("CAT LOOKUP")
Set rng = sh.Range("B34:B56")
rng.ClearContents
Sheets("Ad Hoc Request").Select
End If
CAT_LOOKUP is already defined. When this code is run, the CAT_LOOKUP range is cleared, and the definition of the range is unchanged.
I found in my notes from an old project that I'd used RefersToR1C1 instead of RefersToRange, so I changed that line to this:
ActiveWorkbook.Names("CAT_LOOKUP").RefersToR1C1 = _
"='CAT LOOKUP'!R35C2:R" & sh.Range("B35").End(xlDown).Row & "C2"
and the code worked as desired, resetting the named range so that the corresponding data validation works properly.
Is this simply a bug in the implementation of RefersToRange, or is there a problem with the way we were using it?

RefersToRange is read-only, at least in XL 2003 and probably in 2007.

Related

Autofill formula in defined column VBA [duplicate]

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.

Advanced Filter Issue with multiple criteria for a column

I'm using an advanced filter to copy data from a main worksheet 'SDC' and adding into different workbook tables with fewer headings. The filter criteria are created on a different sheet.
Now, I use the same code for the same data, but adding it into other workbook tables earlier in the code, and it works absolutely fine.
Last week the same code worked for this new workbook, but today it decided to start giving errors.... without having changed any code.
I've spent 6 hours trying to figure out the problem, but no success yet.
I did a couple of tests to see where the issues come in:
When I use the same headings as the destination table (but put them on a new sheet), and manually do the advanced filter, It works fine.
When I tried manually doing the advanced filter to the one destination workbook, it worked, and then the next time after that nothing happens. Very strange...
I've checked all the headings to make sure they match, no spaces anywhere. Still, nothing gets added to the destination workbook tables when I run the advanced filter manually.
I've checked the ranges in the watch window when the macro runs step by step, and everything seems fine. (until the error comes up with the advanced filter)
I don't understand how it worked before, and suddenly starting giving errors. Then it worked for one table and then not. It seems to be this one workbook that has issues or maybe because I'm using multiple criteria for one column? (but it works manually). What am I missing?
I get an error when the advanced filter has to run in the macro: Run-time error '1004': AdvancedFilter method of range class failed on the code line
SDCRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=OOSdirectCrit, CopyToRange:=copyToRng, Unique:=False
Code I'm currently using (which works earlier in the code, just adding to different workbook tables)
Sub StockAvail(wb As Workbook, ws As Worksheet)
Dim SATemp As String
Dim SATempF As String
Dim wsSDC As Worksheet
Set wsSDC = MainWB.Worksheets(1)
SATemp = Dir(TemplPath & "\*Stock Availability*.xls*")
SATempF = TemplPath & "\" & SATemp
'Check if workbook open if not open it
If Not wbOpen(SATempF, wb) Then
Set wb = Workbooks.Open(SATempF)
End If
'Call function add Vendor,Region, etc
Call VInfoAdd(wb, ws)
'Create Filter Criteria ranges
With MainWB.Worksheets.Add
.Name = "FltrCrit"
Dim FltrCrit As Worksheet
Set FltrCrit = MainWB.Worksheets("FltrCrit")
End With
'Create Filter Criteria ranges
With FltrCrit
Dim OOSdirectCrit As Range
Dim myLastColumn As Long
'Create OOS - Direct Filter Criteria Range
.Cells(1, "A") = "Out of Stock - Direct"
.Cells(2, "A") = "MS"
.Cells(3, "A") = "=4"
.Cells(2, "B") = "SOH"
.Cells(3, "B") = "=0"
.Cells(2, "C") = "Sup.Vend."
.Cells(3, "C") = "<>MA05"
.Cells(2, "D") = "Sup.Vend."
.Cells(3, "D") = "<>MA07"
.Cells(2, "E") = "Sup.Vend."
.Cells(3, "E") = "<>MA09"
.Cells(2, "F") = "Sup.Vend."
.Cells(3, "F") = "<>MA11"
'get last column, set range name
With .Cells
'find last column of data cell range
myLastColumn = .Cells(2, Columns.Count).End(xlToLeft).Column
'specify cell range
Set OOSdirectCrit = .Range(.Cells(2, "A:A"), .Cells(3, myLastColumn))
End With
'Copy Filtered data to specified tables
Dim tblFiltered As ListObject
Dim copyToRng As Range, SDCRange As Range
'OOS - Direct
'Store Filtered table in variable
Set tblFiltered = wb.Worksheets("Out of Stock (Direct Supply)").ListObjects("Table_Out_of_Stock_Direct")
'Remove Filtered table Filters
tblFiltered.AutoFilter.ShowAllData
'Set Copy to range on Filtered sheet table
Set copyToRng = tblFiltered.HeaderRowRange
Set SDCRange = wsSDC.ListObjects("Table_SDCdata").Range
'Use Advanced Filter
SDCRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=OOSdirectCrit, CopyToRange:=copyToRng, Unique:=False
The code is for 2 separate tables with different criteria, the first one to exclude DC codes and second one to include only DC codes. I only included the first one's code above, since it's the first issue (2nd one is the same but should be fixed if I can find the problem with the first one, since it's the same issue)
Any help will be greatly appreciated, I'm lost at where to look for problems with it at this point.

Method Range of Object Worksheet failed excel VBA

I have been stuck on a particular problem I am having with an excel visual basic macro.
I have written a script to simply paste a dynamic range of data from one worksheet to the other, The sheet that is being pasted to is a running sheet that updates to the next empty row each time new data is sent to it.
For certain ranges of data my code breaks and gives me the 1004 error.
I have looked at multiple similar questions and they don't seem to have given me any solutions.
I will first post my code then a data set that works and a data set that does not.
Private Sub RunningSheetClick_Click()
Dim lastrow As Long
Dim Vals As Range
Dim copyWS As Worksheet
Dim pasteWS As Worksheet
Set pasteWS = Sheets("Full List")
Set copyWS = Sheets("Macro Test")
Setlastrow = Sheets("Full List").Range("A" & Rows.count).End(xlUp).Row + 1
copyWS.Activate
' the following line is where my error appears
Set Vals = copyWS.Range("B3:S" & copyWS.Range("B3").End(xlDown))
Vals.Select
Vals.Copy _
Destination:=pasteWS.Range("A" & lastrow)
End Sub
This is a data set that works and exports correctly to the sheet "Full List"
This is a data set that does not, I believe it has to do with column B and the strings that are in those cells as compared to the integers in the first data set
Any help would be appreciated, thank you for taking the time
This is bad syntax that should never work. You just cannot concatenate a range object onto a string and expect a valid range object. I suspect it works with numbers since copyWS.Range("B3").End(xlDown) is returning its cell value by default. So if the value at the bottom of column B was 99, you would be resolved to Range("B3:S99").
Set Vals = copyWS.Range("B3:S" & copyWS.Range("B3").End(xlDown))
It should be something like,
with copyWS
Set Vals = .Range(.cells(3, "B"), .cells(rows.count, "B").end(xlup).offset(0, 17))
end with

How to find string in another sheet and copy/paste data to current sheet

I'm trying to construct a macro to find the same part name as I have highlighted in my "Tests" sheet in my "Part Catalog" sheet.
From here, I would like to copy the date when the part was manufactured (which is one column to the right of the part name) from the "Part Catalog" sheet, and paste it in a cell one column to the right of the part name in the "Tests" sheet.
I get an error saying that "Object doesn't support this property or method."
The code below is taken and slightly modified from this link: (http://www.ozgrid.com/forum/showthread.php?t=158840&p=578982#post578982). Previous attempts included me using for loops, but the majority of people seem to agree that the .find function works the best for things like this.
Any help would be appreciated! Thank you!
Sub Get_Date()
Dim Partname As String
Dim sh As Worksheet
Dim ws As Worksheet
Set sh = Sheets("Tests")
Set ws = Sheets("Part Catalog")
Partname = ActiveCell.Value
ws.Cells.Find(Partname).Offset(0, 1).Copy
sh.Cells.Find(Partname).Offset(0, 1).Paste
End Sub
For your follow on question:
Assumes you have the entire list of part names selected first:
Dim sh As Worksheet
Dim ws As Worksheet
Dim c, rng As Range
Set sh = Sheets("Tests")
Set ws = Sheets("Part Catalog")
Set rng = Selection
For Each c In rng
ws.Cells.Find(c.Value).Offset(0, 1).Copy Destination:=c.Offset(0, 1)
Next c
This uses a loop to go through each part (cell) in your selection.

VBA storing a range in a cell

I have a problem in VBA where I store a cell address as a range contained in a global variable. Problem is, any error and it stops working as it loses the variable. I'm trying to catch as many errors as I can, but I'd prefer to store the range in a cell if possible.
Does anyone have any suggestions?
Thanks
James
I would store the range in a Defined Name:
Assuming the name is called CellAddr and it already exists
Names("CellAddr").RefersTo = "=" & Worksheets("Sheet2").Range("A3:B8").Address(True, True, xlA1, True)
Then you can retrieve the range values or range address using the defined name.
You can also hide the name if you want, and it will persist in a saved workbook
I think something like this is what you are looking for, the Address property of Range returns the string of the Range
Edit: have ammended to show the name of the Worksheet
Public oRng As Range
Sub storeRange()
Dim oWst1, oWst2 As Worksheet
Dim oCell As Range
Set oWst1 = Application.Worksheets("Sheet1")
Set oWst2 = Application.Worksheets("Sheet2")
Set oCell = oWst1.Range("A1")
Set oRng = oWst2.Range("B2")
oCell.Value = oWst2.Name & "!" & oRng.Address
End Sub

Resources