VBA Index Match function - excel

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)

Related

Calling excel from solidworks works 1 time out of 2

This may sound a little bit dumb, but I have never experienced anything like this before with SolidWorks macro. I have written a SolidWorks macro that inserts a BOM table into an assembly saves it as excel, and adds needed formulas to an excel file. However it works 1 time out of 2- 1st time- all good, 2nd time I get an error- "Run-time error '1004' Method 'Rows' of object '_Global' Failed", 3rd time- all good, 4th time I get the same error and so on and so on. I'm really new to excel macro so I don't know if I'm missing something or just stupid?
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swBOMAnnotation As SldWorks.BomTableAnnotation
Dim i As Integer
Dim nNumRow As Variant
Dim swTableAnn As SldWorks.TableAnnotation
Dim swAnn As SldWorks.Annotation
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim template As String
Dim fType As String
Dim configuration As String
'excel variables
Dim x1App As Excel.Application
Dim xlWB As Excel.Workbook
Dim NextRow As Long
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension
template = "C:\Program Files\SOLIDWORKS Corp\SOLIDWORKS\lang\english\bom-all.sldbomtbt"
fType = swBomType_PartsOnly
configuration = "Default"
Set swBOMAnnotation = swModelDocExt.InsertBomTable3(template, 770, 240, fType, configuration, False, 2, True)
Dim path As String
path = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, "\"))
Dim fpath As String
fpath = Format(path & "BOM\")
On Error Resume Next
MkDir (fpath)
On Error GoTo 0
Dim fName As String
fName = Format(fpath & "TEST.xls")
swBOMAnnotation.SaveAsExcel fName, False, False
Set swTableAnn = swBOMAnnotation
Set swAnn = swTableAnn.GetAnnotation
swAnn.Select3 False, Nothing
swModel.EditDelete
'Excel part
Set x1App = New Excel.Application
x1App.Visible = True
Set xlWB = x1App.Workbooks.Open(fName)
With Range("G3:G" & Cells(Rows.Count, "C").End(xlUp).Row)
.Formula = "=C3*F3"
End With
NextRow = Range("G" & Rows.Count).End(xlUp).Row + 1
Range("G" & NextRow).Formula = "=SUM(G2:G" & NextRow - 1 & ")"
End Sub
Not sure what's causing the behavior you're describing but here are a few thoughts that might point you in the right direction.
Objects in macros are persistent, meaning swModel (and other objects) will still exist after the macro is run. This is why you need to set it to 'Nothing' before using it again.
"Rows" is not defined anywhere so I'm surprised that code works at all. It must be late binding it to something... Rows is a method for an excel range but you're not using it that way. (range.Rows)
Try getting the row count explicitly in a double and using that instead. I suspect that will fix your issue.

.net Excel Range Address limitation

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

How to return worksheet or workbook name in cell

I am trying to create a code that outputs the date (e.g. 201607) contained within the workbook name (e.g. 20160701_tyo). In the following code, I specify which cell to output the value, but I always run into an error that I didn't "define my object". What am I missing?
Sub WorksheetDateName()
Dim DateName As String, OnlyDate As Long
DateName = ActiveWorkbook.Name
OnlyDate = Left(DateName.Value, 6)
ActiveWorksheet.Range("E1").Value = OnlyDate
End Sub
Also, would it be possible to perform something similar for "ActiveSheet" in addition to "ActiveWorkbook"? Thank you in advance!
For the Workbook name, you could use VBA:
ActiveSheet.Range("E1").Value = Left(ActiveWorkbook.Name, 6)
Or you could just use a formula in E1 such as:
=MID(CELL("filename"),FIND("[",CELL("filename"))+1,6)
For the Worksheet name, if you wanted the first 6 characters you could use VBA:
ActiveSheet.Range("F1").Value = Left(ActiveSheet.Name, 6)
and the equivalent formula would be:
=MID(CELL("filename"),FIND("]",CELL("filename"))+1,6)
Note: both Excel formula require that the file has been saved at least once previously to work correctly.
Looking through your code though, one way to 'fix' it would be to use Val to convert the 6 character string to a value, that can be held in the Long.
Sub WorksheetDateName()
Dim DateName As String, OnlyDate As Long
DateName = ActiveWorkbook.Name
OnlyDate = Val(Left(DateName, 6))
ActiveSheet.Range("G1").Value = OnlyDate
End Sub
You'll also note I've changed ActiveWorksheet to Activesheet - as other comments have suggested.

Index match in VBA referencing a table

I want to update a line in my table based on a cell in another sheet, and to that end I intend to use the index match function. When I run the code below I get the error that it cannot get the property of the match function class.
What is the correct syntax in this regard?
Sub Update_Customer()
' Declarations
Dim rng as listobject
Dim wf as application.worksheetfunction
Dim cs_sht as string
Set rng = Sheets(1).ListObjects("Table_Customer")
Set ws = ThisWorkbook.ActiveSheet
cs_sht = ws.Name
' ERROR RUNNING THIS LINE vvvvv
wf.Index(rng.ListColumns("Firstname"), wf.Match(cs_sht, rng.ListColumns("Customer ID"), 0)) = ws.Range("C_Firstname").Value
End Sub
Excel functions need to be nested, because a cell's value needs to be parsed as a single step.
VBA code doesn't need to do that. VBA instructions work best and are easier to debug when you split them and make them do as little work as possible.
So instead of this:
wf.Index(rng.ListColumns("Firstname"), wf.Match(cs_sht, rng.ListColumns("Customer ID"), 0))
Split it up:
Dim matchResult As Long
matchResult = WorksheetFunction.Match(cs_sht, rng.ListColumns("Customer ID").DataBodyRange, 0)
Dim indexResult As Variant
indexResult = WorksheetFunction.Index(rng.ListColumns("FirstName").DataBodyRange, matchResult)
Note that you'll get a run-time error if either function fails to find what it's looking for. Use On Error to handle that case:
On Error GoTo CleanFail
Dim matchResult As Long
matchResult = WorksheetFunction.Match(...)
...
Exit Sub
CleanFail:
MsgBox "Could not find record for '" & cs_sht & "'." & vbNewLine & Err.Description
End Sub
Get rid of wf. There's no use to copy object references of objects that are already global. The fewer global variables you use, the better.
if the first name changes I can update the table to match the new name from my worksheet
You can't just assign the indexResult to a new value. The indexResult isn't holding a reference to any cell, it's just the result of the INDEX worksheet function. You need to use that result to get the cell you want to modify:
Dim targetCell As Range
Set targetCell = rng.ListColumns("FirstName").DataBodyRange.Cells(indexResult)
targetCell.Value = ws.Range("C_Firstname").Value

I only want to import the last 3 days of text files into Excel

I have a folder with over 16,000 files and I've managed to find some code that won't break Excel when it searches all of the files. Now I need some code that will import the last 3 days worth of text files. Any help would be appreciated.
Current code:
Sub ReadFilesIntoActiveSheet()
Dim fso As FileSystemObject
Dim folder As folder
Dim file As file
Dim FileText As TextStream
Dim TextLine As String
Dim Items() As String
Dim i As Long
Dim cl As Range
Dim dateToCheck As Date
Dim daysBack As Integer
Dim filesCheckd As Integer
filesChecked = 0
daysBack = 5
dateToCheck = DateAdd("d", -daysBack, Date)
Dim StrFile As String
StrFile = Dir("X:\TMS\TRUCK_OUT\")
Do While Len(StrFile) > 0
filesChecked = filesChecked + 1
StrFile = Dir
Loop
MsgBox filesChecked
Set FileText = Nothing
Set file = Nothing
Set folder = Nothing
Set fso = Nothing
End Sub
I told you the function to use and your response was to ask me to explain how to use it. The implication is that you know so little about Excel VBA that even knowing which function to use is not enough to add two extra statements to your code.
You must invest some time in learning the basics of Excel VBA. Trying to get a macro written for you without knowing the basics will probably fail. If you are successful, it will take a long time if you are only going to get a few lines per question.
Search the internet for "Excel VBA tutorial". There are many to choose from. Alternatively, visit a good bookshop or library and look for Excel VBA Primers. Again many to choose from. The time you invest in learning the basics will very quickly repay itself.
Issue 1
The first declaration is Dim fso As FileSystemObject. This will only compile if one of your references is for the Microsoft Scripting RunTime. You do not use fso. Are you planning to use it later? Why have you used Dir rather than the Files property of the folder object you have declared?
Issue 2
What do you mean by: "I've managed to find some code that won't break Excel when it searches all of the files." What code did you have which broke Excel?
Issue 3
Dim daysBack As Integer declares a 16-bit integer. Unless you have an old 16-bit computer, this will require extra processing. Dim i As Long declares a 32-bit integer and it the correct choice.
Issue 4
Dir returns a Variant. Dir$ returns a String and is faster.
None of the above issues are immediately important. I trying to show some of the little things you do not know about Excel VBA and the traps waiting to catch you when you do not know the basics.
For the version of your macro below, I have:
Indented the code to make it easier to read.
Commented out statements you do not current use.
Added two statements so only files with a Last Modified Date after dateToCheck are counted.
This will take you a little further.
Sub ReadFilesIntoActiveSheet()
'Dim fso As FileSystemObject
'Dim folder As folder
'Dim file As file
'Dim FileText As TextStream
'Dim TextLine As String
'Dim Items() As String
'Dim i As Long
'Dim cl As Range
Dim dateToCheck As Date
Dim daysBack As Integer
Dim filesCheckd As Integer
Dim StrFile As String
Dim PathRoot As String
filesChecked = 0
daysBack = 5
dateToCheck = DateAdd("d", -daysBack, Date)
PathRoot = "X:\TMS\TRUCK_OUT\"
StrFile = Dir$(PathRoot)
Do While Len(StrFile) > 0
If FileDateTime(PathRoot & StrFile) < dateToCheck Then
filesChecked = filesChecked + 1
End If
StrFile = Dir$
Loop
MsgBox filesChecked
'Set FileText = Nothing
'Set file = Nothing
'Set folder = Nothing
'Set fso = Nothing
End Sub

Resources