I want to define multiple areas in one single Excel.Range object. The purpose is to colorize multiple different areas by setting one single Range. This should save time using the Excel interop, which is very slow in such operations. The problem is, that I get an error (HRESULT: 0x800A03EC) when I try to put a "big" address line into the Range. Could somebody tell me if there is a limitation using Excel interop and does anybody have a solution for colorizing lots of areas at once / in a fast manner?
The "big" address line in the example is just to show you where the problem is. I know it does not make a lot of sense to put A1:A2 multiple times into the address.
Dim objExcelApp As New Excel.Application
objExcelApp.Visible = True
Dim objExcelWorkbooks As Excel.Workbooks = objExcelApp.Workbooks
Dim objExcelWB As Excel.Workbook = objExcelWorkbooks.Add
Dim objExcelWS As Excel.Worksheet = objExcelWB.Worksheets(1)
Dim rng As Excel.Range
rng = objExcelWS.Range("A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2;A1:A2")
The most likely cause of your issue is that you are trying to create an array of values from a complex multi-area range.
(Edit: I have removed the extra information based on VBA, not VB.Net, which is not relevant to the Question).
The following StackOverflow Q&A also addresses other causes and solutions: HRESULT: 0x800A03EC on Worksheet.range
I found a really fast possibilty in filling a multi-area range with more content in using the Union function in combination with the approach of splitting the address into chunks of 255 char strings. This function does the job very well. This code is with semicolon, because its a country specific seperator it seems (comma is not working in my case, maybe you can modify it). Thanks #K.Dᴀᴠɪs for the hint:
Private Function CombineAddressToRange(ByVal Address As String, ByVal objExcelWorksheet As Excel.Worksheet, ByVal objExcelApp As Excel.Application) As Excel.Range
Dim SplitAddress As String()
Dim TempAddress As String = ""
Dim FinalRange As Excel.Range
SplitAddress = Address.Split(";")
'Initialize Range
FinalRange = objExcelWorksheet.Range(SplitAddress(0))
If UBound(SplitAddress) >= 1 Then
For i = 1 To UBound(SplitAddress)
If Len(TempAddress) + 1 + Len(SplitAddress(i)) > 255 Then
FinalRange = objExcelApp.Union(FinalRange, objExcelWorksheet.Range(TempAddress))
TempAddress = SplitAddress(i)
Else
If TempAddress = "" Then
TempAddress = SplitAddress(i)
Else
TempAddress = TempAddress & ";" & SplitAddress(i)
End If
End If
Next
If TempAddress <> "" Then
FinalRange = objExcelApp.Union(FinalRange, objExcelWorksheet.Range(TempAddress))
End If
End If
Return FinalRange
End Function
Related
I am new to vba and totally lost in writing the above mentioned function in vba. Actually, I want to do the same thing I would do with the usual excel formula.
Update:
Based on the answer of Scott I have adjusted my code. Now I have a Type mismatch error. The Type of Mname by definition is a string. The values in the lookup Range (B18:B38) are (not exclusive) integer. Should I tell Excel to take them as a string? If yes, how?
Summary:
I have a range (D18:D38) where I want to chose a value from based on the row number determined by a match between a string Variable (Mname) and another range (B18:B38). The string Variable is determined by the name of a file in a folder.
My Problem is that I get the error message: 'Unable to get the match property of the worksheetfunction class'
Thanks for your help!
Sub Test()
Application.ScreenUpdating = False
Dim Mname As String
Set WSCockpit = ThisWorkbook.ActiveSheet
Dim strFileName As String
Dim strFolder As String: strFolder = WSCockpit.Range("D9").Value
Dim strFileSpec As String: strFileSpec = strFolder & "*.xls*"
strFileName = Dir(strFileSpec)
Do While Len(strFileName) > 0
Dim strFilePath As String: strFilePath = strFolder & strFileName
Mname = Mid(strFileName, 13, Len(strFileName) - 17)
Dim rw As Long
rw = Application.Match(Mname, WSCockpit.Range("B18:B38"), 0)
Dim VarImp As Boolean
VarImp = Application.WorksheetFunction.Index(WSCockpit.Range("D18:D38"), rw)
'some other task'
Loop
Application.DisplayAlerts = True
End Sub
Backup:
Sorry for the code being messy. I have no clue about the general rules for writing vba. Like mentioned before, my goal is to get the lookup running. The looked up value will be "TRUE" or "FALSE". Afterwards I will use this in order to determine whether the file found in the folder needs to be imported or not. If you have some other suggestions for my coding or for the task I want to perform, I would be glad to hear.
Break it into steps and also ensure the data you expect to find in the lookup is in indeed there. Meaning, check the value of Mname at run-time (via debugging code) and verify you can find it manually.
Lastly, use Application.Match instead.
Dim rw as Long
rw = Application.Match(Mname, WSCockpit.Range("B18:B38"),0)
Dim import as Boolean
import = Application.WorksheetFunction.Index(WSCockpit.Range("D18:D38"),rw)
I need to classify each row of a range accordingly with another range. The script works just fine. But it takes too much time even if it has no more than 300 rows. E.g. 298 rows take more than 2 minutes.
In order to achieve the classification, the script was built with a for each loop inside another one. All is done in the same worksheet called WSSeg. I tried to use all the good practices that I know of.
Option Explicit
Sub Input_Classification()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim TBLClassification As ListObject
Dim TBLReference As ListObject
Dim rClassificationCell As Range
Dim rClassification As Range
Dim rReferenceCell As Range
Dim rReference As Range
Set TBLClassification = WSSeg.ListObjects("TBClass")
Set rClassification = TBL.ListColumns(4).DataBodyRange
Set TBLReference = WSSeg.ListObjects("TBResumo")
Set rReference = TBL.ListColumns(4).DataBodyRange
For Each rClassificationCell In rClassification
For Each rReferenceCell In rReference
If rClassificationCell.Offset(0, -1).Value <= rReferenceCell.Value Then
rClassificationCell.Value = rReferenceCell.Value
End If
Next rReferenceCell
Next rClassificationCell
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
I expect the run time code to be shorter. I don't know if I have to use another logic system. Thanks in advance.
Tried to modify the code, it takes only 0.04 Secs with two tables of around 500 rows.
Tried to keep the replacement logic same as the original, But may please check the same, as i am little confused about the same. If find otherwise, please modify them to your need. Also Could not understand the what is TBL in cases with both the tables and assumed the obvious.
Option Explicit
Sub Input_Classification()
Dim WSSeg As Worksheet
Dim TBLClassification As ListObject
Dim TBLReference As ListObject
Dim rClassification As Range
Dim SrcArr As Variant, TrgArr As Variant, SrcCel As Variant
Dim i As Long, Tm As Double
Set WSSeg = ThisWorkbook.Sheets("Sheet1")
Tm = Timer
Set TBLClassification = WSSeg.ListObjects("TBClass")
Set rClassification = TBLClassification.ListColumns(3).DataBodyRange.Resize(TBLClassification.DataBodyRange.Rows.Count, 2)
TrgArr = rClassification.Value
Set TBLReference = WSSeg.ListObjects("TBResumo")
SrcArr = TBLReference.ListColumns(4).DataBodyRange.Value
For i = 1 To UBound(TrgArr, 1)
For Each SrcCel In SrcArr
If TrgArr(i, 1) <= SrcCel Then
TrgArr(i, 2) = SrcCel
End If
Next SrcCel
Next i
rClassification.Value = TrgArr
Debug.Print "Seconds taken " & Timer - Tm
End Sub
Since I personally don't prefer to keep calculations, event processing and screen updating off (in normal cases) i haven't added that standard lines. However you may use these standard techniques, depending on the working file condition.
I'm writing some code for a client which pulls data from many differently laid out files. I wanted to write something which was quite flexible for him in the future.
Therefore, he will be able to write for example y.offset(0,1) in a cell depending where in regards to the variable y the data will be.
The reason I haven't just made the the variable 1 is because it, and therefore the cell, may or may not include multiple & "blah blah"
Basically, I'm wondering if it's possible to write parts of code in a cell then pull them up and incorporate them into code.
For instance:
Dim y as range
Dim x as range
Dim c as string
Set Y = Sheet1.range("G4")
c = sheet1.range("A1") [which contains the words y.offset(0,4)
Set x = c
This doesn't work, however I'm wondering if there's anything that can be done to get the same result.
Your need is kind of a recursive and dangerous one
then it deserves such a recursive and dangerous answer
you could use the VBA Project Object Model (see here for info) and act as follows:
Set your project to handle VBA Object Model
follow all the steps you can see in the Introduction of the above given link to cpearson website Add reference to your project
Disclaimer: please also read the CAUTION note in there
add "helper" module
add to your project a new Module and call it after "HelperModule" (you can call it as you like, but then be consistent with the chosen name)
then add this code into this new module
Function GetRange(refRng As Range) As Range
Set GetRange = refRng
End Function
Function SetToCellContent(refRng As Range, cellContent As String) As Range
UpdateCodeModule cellContent
Set SetToCellContent = HelpModule.GetRange(refRng)
End Function
Sub UpdateCodeModule(cellContent As String)
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long
Set CodeMod = ActiveWorkbook.VBProject.VBComponents("HelperModule").CodeModule
LineNum = SearchCodeModuleLine(CodeMod, "Set GetRange")
CodeMod.ReplaceLine LineNum, " Set GetRange = " & cellContent
End Sub
Function SearchCodeModuleLine(CodeMod As VBIDE.CodeModule, FindWhat As String) As Long
Dim SL As Long ' start line
Dim SC As Long ' start column
Dim EL As Long ' end line
Dim EC As Long ' end column
Dim Found As Boolean
With CodeMod
SL = 1
EL = .CountOfLines
SC = 1
EC = 255
Found = .Find(Target:=FindWhat, StartLine:=SL, StartColumn:=SC, EndLine:=EL, EndColumn:=EC, wholeword:=True, MatchCase:=False, patternsearch:=False)
End With
SearchCodeModuleLine = SL
End Function
Add this code to your main code
Set x = SetToCellContent(y, c) '<--| call the function that will take care of updating code in 'GetRange()' function and returns a range relative to 'y' as per the "code" in 'c'
I just want to be able to search a range of cells for a value from a combobox then if found store it somewhere to be used in a bunch of other calculations but I can't get it to work at all.
I really don't understand what the find function is actually doing. Does it return a range variable that identifies where the input has been found? And if so how do I reference/use that range?
Please don't just post code without an explanation I would really like to understand what is going on here.
Sub run_averages()
Dim x As Integer
Dim rngFindValue As Range
Set dd = ActiveSheet.DropDowns("thing")
Set aa = ActiveSheet.DropDowns("otherthing")
With Range("E3:DI3")
Set rngFindValue = .Find(What:=" & aa &", _
After:=ActiveSheet.Range("E3"), LookIn:=xlFormulas)
With rngFindValue
rngFindValue.Active
End With
End With
End Sub
using the following code as you did:
Set rngFindValue = .Find(What:=" & aa....
You reference found cell as Range. Therefore if you want to work with values of that particular cell, you can work with it as with any Range() -> rngFindValue.Value
Try this out:
Dim x As Long
Dim myitem As String, rngFindValue As Range
x = Activesheet.Shapes("thing").ControlFormat.Value
myitem = Activesheet.Shapes("thing").ControlFormat.List(x)
With Range("E3:DI3")
Set rngFindValue = .Find(what:=myitem, after:=[DI3], LookIn:=xlFormulas)
rngFindValue.Select '~~> or do whatever you want with your found range
End With
I am going nuts here ! I cannot understand the error messaging that I'm being given.
Sub run_averages()
Dim x As Integer
Dim rngFindValue As Range
Dim rngFindstart As Range
Dim myitem As Integer
Set dd = ActiveSheet.DropDowns("thing_length")
Set aa = ActiveSheet.DropDowns("thing_date")
myitem = ActiveSheet.Cells(5, 1).Value
' using beans text to make sure error is not coming from drop down reference
Set rngFindValue = Range("E3:DI3").Find(What:="beans", After:=ActiveSheet.Range("E3"), LookIn:=xlFormulas)
With ActiveSheet
.Range(.Cells(3, 1), .Cells(rngFindValue.Row, rngFindValue.Column)).Select
End With
End Sub
It is telling me that "Run time error 91 Object variable or With block not set" if rngFindValue is the only object i am using then it has been set by the fact it is created..
What object does not exist ?
I am clearly missing something fundamental.
Thanks.
Wait. I'm a noob. There was no "beans" text in the document so it was giving me that error...
I've an Excel file with a bunch of columns, one of which is "ImageURL", which, of course, displays unique URLs as text.
How could I set it up such that those images are also depicted within another column?
I've used the following macro, but I get a "Invalid outside procedure" compile error.
Dim url_column As Range
Dim image_column As Range
Set url_column = Worksheets(1).UsedRange.Columns("C")
Set image_column = Worksheets(1).UsedRange.Columns("N")
Dim i As Long
For i = 1 To url_column.Cells.Count
With image_column.Worksheet.Pictures.Insert(url_column.Cells(i).Value)
.Left = image_column.Cells(i).Left
.Top = image_column.Cells(i).Top
image_column.Cells(i).EntireRow.RowHeight = .Height
End With
Next
I am, unfortunately, new to VBA, so perhaps, I've not set it up correctly?
Ok, this may sound pretty basic (no pun intended), but based on the limited information you made available, I think that the cause of your problem is that you just pasted those statements in your code module and didn't put them inside a procedure. That will certainly give you an "Invalid outside procedure" compile-time error.
You have to put stuff inside a procedure -- either a Sub or a Function. This case calls for a Sub. Try this:
Sub PlaceImageInCell()
Dim url_column As Range
Dim image_column As Range
Set url_column = Worksheets(1).UsedRange.Columns("A")
Set image_column = Worksheets(1).UsedRange.Columns("B")
Dim i As Long
For i = 1 To url_column.Cells.Count
With image_column.Worksheet.Pictures.Insert(url_column.Cells(i).Value)
.Left = image_column.Cells(i).Left
.Top = image_column.Cells(i).Top
image_column.Cells(i).EntireRow.RowHeight = .Height
End With
Next
End Sub
.Pictures.Insert(stuff) doesn't work in XL 2007 - and I've seen suggestions to use *.Shapes.AddPicture() instead.
Problem is that it requires a String for the filePath and I'm not familiar enough with VBA to make this work.
Sub InsertImage()
Dim urlColumn As Range
Dim imgColumn As Range
Dim fp as String
Set urlColumn = Worksheets(1).UsedRange.Columns("A")
Set imgColumn = Worksheets(1).UsedRange.Columns("B")
Dim i As Long
For i = 2 To urlColumn.Cells.Count
With imgColumn.Worksheet.Shapes.AddPicture(fp, msoTrue, msoTrue, 1, 1, 12, 12)
End With
Next
End Sub
The end result is the following Error:
Compile Error:
Object Required