I have around 236 named ranges (columns) for a large table of data. I get this error when trying to split up the long code-line of delimited named ranges:
Run-time error '1004' Application-defined or object-defined error
E.g.:
Worksheets("Sheet1").Range("foo1,foo2" _
& "foo3,foo4" _
& "..." _
& "foo235,foo236")
I am trying to filter and unfilter columns based on specific criteria (named ranges). Everything seems to work fine (for smaller strings that only span 1 line in length) until I have to split the code into multiple lines since it reaches the end of the window..
Code -
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$3" Then
Worksheets("Sheet1").Range("Fruit," _
& "Months,Colour").EntireColumn.Hidden = Target.Value = "CustomView"
End If
If Target.Address = "$B$3" Then
Worksheets("Sheet1").Range("Colour,Number" _
& "Months").EntireColumn.Hidden = Target.Value = "Custom2View"
End If
End Sub
This code doesn't seem to work. I think it has something to do with the quotes and how excel reads it but i haven't been able to find a fix yet.
New code being tested based on suggestions in comments results in an error Run-time error '1004' Application-defined or object-defined error
Private Sub Worksheet_Change(ByVal Target As Range)
Dim arr, i As Long, rng As Range
If Target.Address = "$B$3" Then
arr = Split("foo1,foo2,foo3,...,foo266,foo267", ",")
Set rng = Worksheets("Database").Range(arr(0))
For i = 1 To UBound(arr)
Set rng = Application.Union(rng, Worksheets("Database").Range(arr(i)))
Next i
rng.EntireColumn.Hidden = (Target.Value = "CustomView")
End If
End Sub
You can use Application.Union to build up a range and then hide/show that range in one shot.
EDIT: based on your second shared file I think you need something like this. Your previous code was not checking the value of the "view name" cell and was applying all of the views, leaving you with the last one...
Eg:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim arr, q As Long, rng As Range, sht As Worksheet
Set sht = Worksheets("Database")
If Target.Address = "$B$3" Then
'unhide all columns forst
sht.UsedRange.EntireColumn.Hidden = False
Select Case Target.Value
Case "CustomView"
arr = Split("A,B,C_,X,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM," & _
"AN,AO,AP,AQ,AR,AS,AT,AV,AW,AX,AY,AZ,BA,BB,BC,BD,BE,BF,BG," & _
"BH,BI,BJ,BK,BL,BM,BN,BO,BP,BQ,BR,BS,BT,BU,BV,BW,BX,BY,BZ,CA," & _
"CB,CC,CD,CE,CF,CG,CH,CI,CJ,CK,CL,CU,CV,CW,CX,CY,CZ,DA,DB,DC", ",")
Case "XX100View"
arr = Split("D,E,F,G,X,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM,AN,AO," & _
"AP,AQ,AR,AS,AT,AV,AW,AX,AY,AZ,BA,BB,BC,BD,BE,BF,BG,BH,BI,BJ," & _
"BK,BL,BM,BN,BO,BP,BQ,BR,BS,BT,BU,BV,BW,BX,BY,BZ,CA,CB,CC,CD,CE," & _
"CF,CG,CH,CI,CJ,CK,CL,CU,CV,CW,CX,CY,CZ,DA,DB,DC", ",")
Case "OtherView"
arr = Split("A,B,D,E,F,G,H,I,X,AC,AD,AE,AF,AG,AH,AI,AJ,AK,AL,AM," & _
"AN,AO,AP,AQ,AR,AS,AT,AV,AW,AX,AY,AZ,BA,BB,BC,BD,BE,BF,BG,BH," & _
"BI,BJ,BK,BL,BM,BN,BO,BP,BQ,BR,BS,BT,BU,BV,BW,BX,BY,BZ,CA,CB," & _
"CC,CD,CE,CF,CG,CH,CI,CJ,CK,CL,CU,CV,CW,CX,CY,CZ,DA,DB,DC", ",")
End Select
If Not IsEmpty(arr) Then
Set rng = sht.Range(arr(0))
For q = 1 To UBound(arr)
Set rng = Application.Union(rng, sht.Range(arr(q)))
Next q
rng.EntireColumn.Hidden = True '<<edited
End If 'got a view
End If 'is view name cell
End Sub
PS - your range names don't need to include all of your data: a single cell would be fine, since you use EntireColumn to expand it to the entire sheet height anyway.
My questions is: How can I add multiple vLookup-formulas into one cell over VBA?
I know that I can add one vLookUp like this:
... = Application.WorksheetFunction.vLookUp("Search","Matrix","Index")
My Problem is: I have a workbook with 255 pages and in my "sum-sheet" I need variable formulas that search in those 255 worksheets for the data I need.
So the output of the macro in excel needs to be something like (all of in one cell):
=vLoookUp($A2;Sheet1!A1:A1000;2)+SVERWEIS($A2;Sheet2!A1:A1000;2)+ ...(255 times)
Is it even possible to do something like that with VBA?
This is the code I used to split the different options into the 255 sheets:
This is the code I wrote so far to split the different variations of stocks:
(Its somewhat working but I'm kind of sure its not very efficient, I'm new to all this Programming Stuff)
Sub Sheets()
Application.ScreenUpdating = False
ActiveWindow.WindowState = xlMinimized
Dim Data As String
Dim i As Long
Dim k As Long
Dim x As Long
Dim y As String
For i = 2 To 255
Sheetname = Worksheets("Input").Cells(i, 1).Value
Worksheets.Add.Name = Sheetname
ActiveSheet.Move After:=Worksheets(ActiveWorkbook.Sheets.Count)
x = 1
For k = 2 To 876
Data = Worksheets("Input").Cells(i, k).Value
y = Cells(1, x).Address(RowAbsolute:=False, ColumnAbsolute:=False)
BloomB = "=BDH(" & y & ",""TURNOVER"",""8/1/2011"",""4/30/2016"",""Dir=V"",""Dts=S"",""Sort=A"",""Quote=C"",""QtTyp=Y"",""Days=T"",""Per=cd"",""DtFmt=D"",""UseDPDF=Y"")"
Worksheets(Sheetname).Cells(1, x) = Data
Worksheets(Sheetname).Cells(2, x) = BloomB
x = x + 2
Next k
Application.Wait (Now + TimeValue("0:00:05"))
Next i
ActiveWindow.WindowState = xlMaximized
Application.ScreenUpdating = True
End Sub
Sorry, but this sounds like a very bad design. Maybe Access or SQL Server would be better suited for this kind of task. Also, you know the VLOOKUP function will return the first match, but no subsequent matches, right. Just want to make you aware of that. Ok, now try this.
Function VLOOKAllSheets(Look_Value As Variant, Tble_Array As Range, _
Col_num As Integer, Optional Range_look As Boolean)
''''''''''''''''''''''''''''''''''''''''''''''''
'Written by OzGrid.com
'Use VLOOKUP to Look across ALL Worksheets and stops _
at the first match found.
'''''''''''''''''''''''''''''''''''''''''''''''''
Dim wSheet As Worksheet
Dim vFound
On Error Resume Next
For Each wSheet In ActiveWorkbook.Worksheets
With wSheet
Set Tble_Array = .Range(Tble_Array.Address)
vFound = WorksheetFunction.VLookup _
(Look_Value, Tble_Array, _
Col_num, Range_look)
End With
If Not IsEmpty(vFound) Then Exit For
Next wSheet
Set Tble_Array = Nothing
VLOOKAllSheets = vFound
End Function
The full description of everything is here.
http://www.ozgrid.com/VBA/VlookupAllSheets.htm
The below code is working fine with me. I need your help and support to make it a function so I can for example write in any cell
=adj() or =adj(A1) and the formula will apply,
Sub adj()
Dim i, j As Integer
Sheet1.Select
With Sheet1
j = Range(ActiveCell.Offset(0, -2), ActiveCell.Offset(0, -2)).Value
For i = 1 To j
ActiveCell.Formula = "=" & Range(ActiveCell.Offset(0, -1), ActiveCell.Offset(0, -1)) & i & "))" & "&char(10)"
Next i
End With
End Sub
It's hard for me to definitively understand what you're trying to do here. I think you're trying to concatenate x number of cells with a separator field.
So, I would do the following changes... obviously you can change accordingly.
Declare the Inputs as variants. If you don't and get a type mismatch the function wont call in debug. This also gives you the opportunity to deal with the Inputs.
Put in an error handler to prevent unwanted debug w.r.t. a failure.
You can't use Evaluate that way. I think you're trying to get an Evaluation of cells like A1 etc.
The function has to be called from a Cell on a sheet since it uses Application.Caller. You shouldn't really need this for the function to work, but I put in in there in case you are calling via F9 calculation.
You can also put in the line if you want the calculation to occur every time you recalculate. However this should be used with caution since you can get some unwanted calculation side effects with some spreadsheets when using this.
Application.Volatile
Public Function Adj(ByVal x As Variant, ByVal y As Variant) As String
On Error GoTo ErrHandler
Dim sSeparator As String, sCol As String
Dim i As Integer
'Get the column reference.
sCol = Split(Columns(y).Address(False, False), ":")(1)
'Activate the sheet.
Application.Caller.Parent.Select
sSeparator = Chr(10)
For i = 1 To x
Adj = Adj & Evaluate(sCol & i) & sSeparator
Next
'Remove the last seperator...
Adj = Left(Adj, Len(Adj) - 1)
Exit Function
ErrHandler:
'Maybe do something with the error return value message here..
'Although this is a string, Excel will implicitly convert to an error.
Adj = "#VALUE!"
End Function
If you wanted to pass change to a formula, and pass in the range, you would use something like:
Public Function Func(Byval MyRange as range) as variant
In this case, you're not specifying a return value so it will be ignored.
Public Function Func(Byval MyRange as range) as variant
Dim i, j As Integer
With MyRange.parent
j = .Range(MyRange.Offset(0, -2), MyRange.Offset(0, -2)).Value
For i = 1 To j
MyRange.Formula = "=" & .Range(MyRange.Offset(0, -1), MyRange.Offset(0, -1)) & i & "))" & "&char(10)"
Next i
End With
End Sub
It would be something like that..
I am working with 3 excel sheets. In sheet Start Page i have Dates starting from column A4 going down. The macro Vlooks up in sheet Fund Trend for the same Dates which are locate in column A11 to lastrow and offsets 3 columns , and copies the Value into sheet "Accrued Expenses" starting from Range("C7"). Macro loops until the lastrow in sheets("Start page") Range("A4") .
The Problem is that the macro is not populating the values into sheet Accrued expenses, on some occasions. OR its not finding the Date. My code is below:
Sub NetAsset_Value()
Dim result As Double
Dim Nav_Date As Worksheet
Dim fund_Trend As Worksheet
Dim lRow As Long
Dim i As Long
Set Nav_Date = Sheets("Start page")
Set fund_Trend = Sheets("Fund Trend")
lRow = Sheets("Start page").Cells(Rows.Count, 1).End(xlUp).row
For i = 4 To lRow
result = Application.WorksheetFunction.VLookup(Nav_Date.Range("A" & i), fund_Trend.Range("A11:C1544"), 3, False)
Sheets("Accrued Expenses").Range("C" & i + 3).Value = result
Sheets("Accrued Expenses").Range("C" & i + 3).NumberFormat = "0.00"
Sheets("Accrued Expenses").Range("C" & i + 3).Style = "Comma"
Next i
End Sub
Error Trap:
On Error Resume Next
result = Application.WorksheetFunction.VLookup(Nav_Date.Range("A" & i), fund_Trend.Range("A11:C1544"), 3, False)
If Err.Number = 0 Then
Sheets("Accrued Expenses").Range("C" & i + 3).Value = result
Sheets("Accrued Expenses").Range("C" & i + 3).NumberFormat = "0.00"
Sheets("Accrued Expenses").Range("C" & i + 3).Style = "Comma"
End If
On Error GoTo 0
To over come the Date issue i have this sub dont know if this is efficient?
Sub dates()
Sheets("Start page").Range("A4", "A50000").NumberFormat = "dd-mm-yyyy"
Sheets("Fund Trend").Range("A11", "A50000").NumberFormat = "dd-mm-yyyy"
End Sub
The issue that i am now having is that when enter a date like 11/02/2015 it switches to 02/11/2015. But its not happening to all Dates
Overcoming the Problem. I am placed a worksheet function to force the date columns to text. Which is currently working.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Sheets("Start page").Range("A4", "A50000").NumberFormat = "#"
Sheets("Fund Trend").Range("A11", "A50000").NumberFormat = "#"
End Sub
To avoid the 1004 error you can use the Application.VLookup function, which allows an error type as a return value. Use this method to test for an error, and if no error, return the result.
To do this, you'll have to Dim result as Variant since (in this example) I put a text/string value in the result to help identify the error occurrences.
If IsError(Application.Vlookup(Nav_Date.Range("A" & i), fund_Trend.Range("A11:C1544"), 3, False)) Then
result = "date not found!"
Else
result = Application.WorksheetFunction.VLookup(Nav_Date.Range("A" & i), fund_Trend.Range("A11:C1544"), 3, False)
End If
The "no result printed in the worksheet" needs further debugging on your end. Have you stepped through the code to ensure that the result is what you expect it to be, for any given lookup value? If there is no error, then what is almost certainly happening is that the formula you have entered is returning a null string and that value is being put in the cell.
How do I code Excel VBA to retrieve the url/address of a hyperlink in a specific cell?
I am working on sheet2 of my workbook and it contains about 300 rows. Each rows have a unique hyperlink at column "AD". What I'm trying to go for is to loop on each blank cells in column "J" and change it's value from blank to the hyperlink URL of it's column "AD" cell. I am currently using this code:
do while....
NextToFill = Sheet2.Range("J1").End(xlDown).Offset(1).Address
On Error Resume Next
GetAddress = Sheet2.Range("AD" & Sheet2.Range(NextToFill).Row).Hyperlinks(1).Address
On Error GoTo 0
loop
Problem with the above code is it always get the address of the first hyperlink because the code is .Hyperlinks(1).Address. Is there anyway to get the hyperlink address by range address like maybe sheet1.range("AD32").Hyperlinks.Address?
This should work:
Dim r As Long, h As Hyperlink
For r = 1 To Range("AD1").End(xlDown).Row
For Each h In ActiveSheet.Hyperlinks
If Cells(r, "AD").Address = h.Range.Address Then
Cells(r, "J") = h.Address
End If
Next h
Next r
It's a bit confusing because Range.Address is totally different than Hyperlink.Address (which is your URL), declaring your types will help a lot. This is another case where putting "Option Explicit" at the top of modules would help.
Not sure why we make a big deal, the code is very simple
Sub ExtractURL()
Dim GetURL As String
For i = 3 To 500
If IsEmpty(Cells(i, 1)) = False Then
Sheets("Sheet2").Range("D" & i).Value =
Sheets("Sheet2").Range("A" & i).Hyperlinks(1).Address
End If
Next i
End Sub
My understanding from the comments is that you already have set the column J to a string of the URL. If so this simple script should do the job (It will hyperlink the cell to the address specified inside the cell, You can change the cell text if you wish by changing the textToDisplay option). If i misunderstood this and the string is in column AD simply work out the column number for AD and replace the following line:
fileLink = Cells(i, the number of column AD)
The script:
Sub AddHyperlink()
Dim fileLink As String
Application.ScreenUpdating = False
With ActiveSheet
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 4 To lastrow
fileLink = Cells(i, 10)
.Hyperlinks.Add Anchor:=Cells(i, 10), _
Address:=fileLink, _
TextToDisplay:=fileLink
Next i
End With
Application.ScreenUpdating = True
End Sub
Try to run for each loop as below:
do while....
NextToFill = Sheet2.Range("J1").End(xlDown).Offset(1).Address
On Error Resume Next
**for each** lnk in Sheet2.Range("AD" & Sheet2.Range(NextToFill).Row).Hyperlinks
GetAddress=lnk.Address
next
On Error GoTo 0
loop
This IMO should be a function to return a string like so.
Public Sub TestHyperLink()
Dim CellRng As Range
Set CellRng = Range("B3")
Dim HyperLinkURLStr As String
HyperLinkURLStr = HyperLinkURLFromCell(CellRng)
Debug.Print HyperLinkURLStr
End Sub
Public Function HyperLinkURLFromCell(CellRng As Range) As String
HyperLinkURLFromCell = CStr(CellRng.Hyperlinks(1).Address)
End Function