I got this code from someone who helped me convert this excel formula to vba. The Excel formula is:
=INDEX('C:\Users\Desktop\[Backlog.xlsx]backlog1'!$J:$J,MATCH(A3,'C:\Users\Desktop\[Backlog.xlsx]backlog1'!$W:$W,0))
The code is:
SetAttr "C:\Users\Desktop\Backlog.xlsx", vbNormal
Dim Backlog As Workbook
Dim bcklog1 As Worksheet
Set Backlog = Workbooks.Open(Filename:="C:\Users\Desktop\Backlog.xlsx", UpdateLinks:=0)
Set bcklog1 = Backlog.Worksheets("backlog1")
Dim result As Variant, test As Variant
Dim frml As Variant, match_row As Variant
frml = "match(A2, " & bcklog1.Range("W:W").Address(external:=True) & ", 0)"
Debug.Print frml
match_row = Evaluate(frml)
Debug.Print match_row
frml = "index(" & bcklog1.Range("J:J").Address(external:=True) & ", " & frml & ")"
Debug.Print frml
result = Evaluate(frml)
test = Application.WorksheetFunction.Index(bcklog1.Range("J:J"), match_row, 1)
Debug.Print test`
I keep getting an error mismatch, I have changed the variables all to Variant and still no success. The sub should use index/match to find values between two different workbooks. Some values will not be found resulting in an "error", which is what I also want to find, the error will represent things I need to focus on. The results should appear in column F:F. I have been stuck on this for a while now, any help is appreciated.
EDIT - updated to use a loop
I'd do it this way...
Sub test()
Dim Backlog As Workbook
Dim bcklog1 As Worksheet
Set Backlog = Workbooks.Open(Filename:="C:\Users\Desktop\Backlog.xlsx", UpdateLinks:=0)
Set bcklog1 = Backlog.Worksheets("backlog1")
Dim m, test, c
' adjust following range as needed
For each c in ActiveSheet.Range("A2:A200").Cells
v = c.Value
If Len(v) > 0 then
'note no "worksheetfunction" or "no match" will raise an error
m = Application.Match(v, bcklog1.Range("W:W"), 0)
'instead we test for no match here...
If Not IsError(m) Then
test = bcklog1.Range("J:J").Cells(m).Value
'Debug.Print test
c.offset(0, 5).Value = test 'populate colF
End If
End If 'cell has a value
Next c
End Sub
If match_row evaluates to an error type (Error 2042 if the match is not found), the assignment to test = Application.WorksheetFunction.Index(... will fail, because the right-side of the assignment statement cannot evaluate, because you're passing the Error 2042 to the Index function.
If Not IsError(match_row) Then
test = Application.WorksheetFunction.Index(bcklog1.Range("J:J"), match_row, 1)
Else
MsgBox "something"
End If
Here is a way that does all of the comparisons an puts them in column F.
This method is interesting from a technical perspective because it uses no VBA loops at all:
Public Sub excelhero()
Const BACKLOG_WB = "C:\Users\Desktop\Backlog.xlsx"
Const BACKLOG_WS = "backlog1"
Dim n&, ws As Worksheet
Set ws = Workbooks.Open(BACKLOG_WB, 0).Worksheets(BACKLOG_WS)
With ThisWorkbook.ActiveSheet
n = .Cells(.Rows.Count, "a").End(xlUp).Row
.Range("f2:f" & n) = ws.Evaluate("transpose(transpose(index(j:j,n(if(1,match([" & .Parent.Name & "]" & .Name & "!a2:a" & n & ",w:w,))))))")
End With
ws.Parent.Close
End Sub
Related
I have a sheet where user picks a value from a dropdown. Then I search for that value on a different sheet, and return the that cell's address. The address is fed to a function that looks through each named range and looks for an intersect. I have thrown in some "debug" info on the function just to see if it's firing, and it's not. I have 3 sheets that it could potentially look through, so i have to be careful to not throw a 1004 error looking for an intersect on different sheets. I'm at a loss here. I'm sure it's something dumb, but I can't find it. Any help is appreciated.
For i = 1 To EndWRow
For j = 1 To EndWColumn
If woodSearch = Worksheets("Woods").Cells(i, j).Value Then
Worksheets("Woods").Activate
x = ActiveSheet.Name
y = Worksheets("Woods").Cells(i, j).Address
Set wMatchCell = Worksheets("Woods").Cells(i, j)
If IsNamedRange(wMatchCell, woodRangeName) Then
MsgBox "Range Name:= " & woodRangeName.Name & Chr(10) & _
"Range RefersTo:= " & woodRangeName
woodRangeNameString = woodRangeName.Name
'Worksheets("Woods").Range(woodRangeNameString).Copy
'Worksheets("Bag 1").Range("B2:H23").PasteSpecial xlPasteValuesAndNumberFormats
'Worksheets("Bag 1").Range("B2:H23").PasteSpecial xlPasteFormats
'Worksheets("Bag 1").Range("B2:H23").PasteSpecial xlPasteColumnWidths
Else
MsgBox "Invalid Selection. Sheet name is: " & x & " and selected address is: " & y
End If
Exit For
End If
Next j
Next i
Find named range function:
Function IsNamedRange(ByVal Target As Range, ByRef NamedRange As Name) As Boolean
Dim nm As Name
Dim i As Integer
i = 7
With ThisWorkbook.Sheets(Target.Parent.Name)
For Each nm In .Names
Sheets("User Entry").Range("B" & i).Value = nm
If Not Application.Intersect(Target, Range(nm)) Is Nothing Then
IsNamedRange = True
Set NamedRange = nm
Exit Function
End If
i = i + 1
Next nm
End With
End Function
At the very least, I feel like this function should at least print all of the named ranges on my sheet (not really desired but I threw it in for debug) and it doesn't do anything. Long and short is the "else" ends up executing...
You can make some changes to make it more generic. Also updated the method name and returned the name as the function's return value - I'm not sure the Boolean + ByRef is getting you anything more than just testing the return value?
Sub Tester()
Dim nm As Name
Set nm = GetMatchedRange(Selection)
If Not nm Is Nothing Then
Debug.Print nm.Name, nm.RefersToRange.Address
Else
Debug.Print "no name"
End If
End Sub
Function GetMatchedRange(ByVal Target As Range) As Name
Dim nm As Name, i As Integer, rng As Range
'always operate on the parent workbook of Target
For Each nm In Target.Worksheet.Parent.Names
'Sheets("User Entry").Range("B" & i).Value = nm
Set rng = Nothing
On Error Resume Next
Set rng = nm.RefersToRange 'not all names refer to ranges...
On Error GoTo 0
If Not rng Is Nothing Then
'does this name refer to a range on the same sheet as Target?
If rng.Parent.Name = Target.Parent.Name Then
If Not Application.Intersect(Target, rng) Is Nothing Then
Set GetMatchedRange = nm
Exit Function
End If
End If
End If
i = i + 1
Next nm
End Function
I'm trying to add items from a file saved in path "C:\Users\se72497\Desktop" which contains in the 1st column of the sheet called "Departamentos" a series of values I want to add in the Combobox.
My combobox receive the name of dept.
Private Sub UserForm_Initialize()
Dim filename As Workbook
Set filename = Workbooks.Open("C:\Users\se72497\Desktop\Tablas_Macro.xlsx")
With filename.Sheets("Departamentos")
dept.List = Range("A2", .Range("A" & Rows.Count).End(xlUp).Value)
End With
End Sub
I've tried to execute this code but it returns me a run-time error:
Why vba returns me this error?
The .Value is in the wrong place. (Or you could say that the parenthesis is in the wrong place). Correcting this, you have:
.Range("A2", .Range("A" & Rows.Count).End(xlUp)).Value
With your current code, .Value is within the Range call, so you're trying to use the value of the cell, not the cell itself, as the 2nd argument.
You want it outside.
Otherwise, if the last cell's value is "foo", then your code is equivalent to
Range("A2", "foo")
which is most certainly not what you want.
So when you click pn your combo box data will get loaded,
' Pre-requisties name the cell A2 with variable rstart
Private Sub UserForm_Initialize()
Dim ws As Worksheet: Set ws = Worksheets("Departamentos")
Dim i As Integer: i = 0
Dim lRow As Long
Dim sAddress As String
On Error GoTo errhandling
If Me.nameofcombobox.Value = vbNullString Then
MsgBox "Select value to continue!"
Else
With ws
lRow = .Range("Departamentos").Rows.Count
'name the cell a2 as rstart
Do Until .Range("rStart").Offset(0, i).Value = Me.nameofcombobox.Value
i = i + 1
Loop
sAddress = .Range("rStart").Offset(0, i - 1).Address
.Range(sAddress & ":" & Left(sAddress, 4) & lRow).Value = .Range(sAddress & ":" & Left(sAddress, 4) & lRow).Value
End With
End If
On Error GoTo 0
MsgBox "Completed without errors", vbInformation, "Success"
FunctionOutput:
Set ws = Nothing
Exit Sub
errhandling:
MsgBox "The following error occurred: " & Err.Description, vbCritical, "Error"
Resume FunctionOutput
End Sub
I am trying to run through some spreadsheet range and use a try/except in order to build an if/else statement. The reason I am doing this is because IsNumeric() is not working for me so I am trying to do something like this (try except formatting from python)
Dim Temp as Integer
Dim Myrange as Range
Dim Myrow as Range
Set Myrange = Range("A1","A1000")
For Each Myrow in Myrange.Row
If IsEmpty(Range("A" & Myrow.Row)) Then
Exit For 'To escape the loop at the end of the filled cells
Else
Try:
Temp = (Myrow.Value() - 0) 'This causes a #VALUE! error when the Myrow.Value is not a number.
Except:
Range("B" & Myrow.Row).Value = Temp 'this sets the value of the rightmost cell to whatever current value of Temp is.
I have also tried some other error catching but can't seem to get it in VBA.
For Each Myrow In Myrange.Rows
If IsEmpty(Range("A" & Myrow.Row)) Then
Exit For
Else
On Error Resume Next
Temp = Myrow.Value() - 0
If Err.Number = 0 Then
Range("A" & Myrow.Row).Value = ""
ElseIf Err.Number <> 0 Then
Range("B" & Myrow.Row) = Temp
End If
End If
Next Myrow
I am really just looking to run down the list, see the first number, set value of B0:Bn1 = Temp, when An is hit (new number), The value of Temp changes to temp2 and then cells Bn1+1 -> Bn2-1 is temp2 until a new number is found etc.
in the worksheet I can do it fine with dragging down formula =(A1-0) to see the error message for those that are not numeric but for some reason I can't code it.
Solved this using advice of #MathieuGuindon by using variant type and testing isnumeric on that. Solution code:
Dim Myrange As Range
Dim Myrow As Range
Dim Temp As Variant
Dim NextTemp As Variant
Set Myrange = Selection
For Each Myrow In Myrange.Rows
NextTemp = Range("A" & Myrow.Row).Value
If IsEmpty(Range("A" & Myrow.Row)) Then
Exit For
ElseIf IsNumeric(NextTemp) Then
Temp = NextTemp
Range("A" & Myrow.Row).Value = ""
Else
Range("B" & Myrow.Row).Value = Temp
End If
Next Myrow
A bit of simplification, and picking up on Mathieu's comments, try this. Not sure what you're doing though so may no be quite right.
Sub x()
Dim Temp As Variant
Dim Myrange As Range
Dim Myrow As Range
Set Myrange = Range("A1", "A1000")
For Each Myrow In Myrange
If Not IsEmpty(Myrow) Then
Temp = Myrow.Value - 0
If IsNumeric(Temp) Then
Myrow.Value = vbNullString
Else
Myrow.Offset(, 1).Value = Temp
End If
End If
Next Myrow
End Sub
One way is to have a dedicated error handler at the end of your sub, and check the error code (13 for Type Mismatch):
Option Explicit
Public Sub EnumerateValues()
On Error GoTo err_handle
Dim Temp As Integer
Dim Myrange As Range
Dim Myrow As Range
Dim myNumber As Double ' Int? Long?
Set Myrange = Range("A1", "A1000")
For Each Myrow In Myrange.Rows
If IsEmpty(Range("A" & Myrow.Row)) Then
Exit For ' to escape loop at end of filled cells
Else
myNumber = CDbl(Myrow.Value())
Debug.Print myNumber
End If
' use label, since VBA doesn't support Continue in loop.
loop_continue:
Next Myrow
exit_me:
Exit Sub
err_handle:
Select Case Err.Number
Case 13 ' Type Mismatch
GoTo loop_continue
Case Else
MsgBox Err.Description, vbOKOnly + vbCritical, Err.Number
GoTo exit_me
End Select
End Sub
This way, if we encounter a value for which CDbl (or the equivalent function) fails, we just continue on to the next row.
While the first example contains Try: and Except: as labels, they provide no error control. Try/Except are vb.net error control methods, not vba.
It's unclear whether you might have text that looks like numbers in column A. If the Temp = (Myrow.Value() - 0) is only meant to determine whether the value in column A is a number and not used as a conversion then SpecialCells can quickly find the numbers in column A.
dim rng as range
on error resume next
'locate typed numbers in column A
set rng = Range("A:A").SpecialCells(xlCellTypeConstants, xlNumbers)
on error goto 0
If not rng is nothing then
rng = vbNullString
End If
on error resume next
'locate text values in column A
set rng = Range("A:A").SpecialCells(xlCellTypeConstants, xlTextValues)
on error goto 0
If not rng is nothing then
rng.Offset(0, 1) = rng.Value
End If
You can also use xlCellTypeFormulas to return numbers or text returned by formulas.
I am having difficulty integrating a Vlookup into a for loop I have to display each value of my collection. The background on this if that I have to check the cells in a column to make sure they are a qualified mnemonic. I have the list of all the mnemonics possible so if the vlookup returns a value then its a mnemonic. To make this a quick check, my collection will display the distinct values and I am trying to display the vlookup result right beside the distinct value. I can't get the vlookup to loop through and I think I also need an error handler, I just can't pin down exactly how to do it. The way its coded right now it will work for the first value but it won't loop, and also if the first value isn't a mnemonic it won't work.
Sub QualityAssurance()
Dim lngLastRow As Long
Dim rngCell As Range, _
rngMyData As Range
Dim clnMyList As New Collection
Dim varMyList As Variant
Dim strMyList As String
Dim Mtch As Variant
'Assumes the dataset is from A2 to A[whatever the last row in Column A is].
'Change to suit
lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
Set rngMyData = Range("A2:A1000" & lngLastRow)
Application.ScreenUpdating = False
On Error Resume Next 'Need to ignore errors as a Collection can only contain unique values
For Each rngCell In rngMyData
clnMyList.Add Item:=rngCell.Value, Key:=CStr(rngCell.Value)
Next rngCell
On Error GoTo 0 'Nullify error handler
For Each varMyList In clnMyList
If strMyList = "" Then
strMyList = varMyList & " = " & Application.WorksheetFunction.VLookup(varMyList, Sheet1.Range("P2:Q8"), 2, 0)
Else:
strMyList = strMyList & vbNewLine & varMyList
End If
Next varMyList
MsgBox strMyList
Application.ScreenUpdating = True
End Sub
If you drop the WorksheetFunction you will not get a run-time error in the event there's no match, and you can instead test the return value to see if it's an error:
Dim r
'....
For Each varMyList In clnMyList
If Len(strMyList) > 0 Then strMyList = strMyList & vbNewLine
r = Application.VLookup(varMyList, Sheet1.Range("P2:Q8"), 2, 0)
strMyList = strMyList & varMyList & " = " & _
IIf(IsError(r), "?Not Found?", r)
Next varMyList
I have this code (This code is in Access VBA which tries to read an excel file and after checking, possibly import it):
Set ExcelApp = CreateObject("Excel.application")
Set Workbook = ExcelApp.Workbooks.Open(FileName)
Set Worksheet = Workbook.Worksheets(1)
now I want to iterate over all rows of the excel worksheet. I want something such as this:
for each row in Worksheet.rows
ProcessARow(row)
next row
where
function ProcessARow(row as ???? )
' process a row
' how Should I define the function
' how can I access each cell in the row
' Is there any way that I can understand how many cell with data exist in the row
end function
My questions:
How to define the for each code that it iterate correctly on all
rows that has data?
How to define ProcessARow properly
How to get the value of each cell in the row.
How to find how many cell with data exist in the row?
Is there any way that I detect what is the data type of each cell?
edit 1
The link solves on problem :
How to define the for each code that it iterate correctly on all rows that has data?
but what about other questions?
For example, how to define ProcessARow correctly?
If you need the values in the Row, you need use the 'Value' Property and after do an cycle to get each value
for each row in Worksheet.rows
Values=row.Value
For each cell in Values
ValueCell=cell
next cell
next row
Unfortunately you questions are very broad however I believe the below sub routine can show you a few ways of achieving what you are after. In regards to what datatype each cell is more involved as it depends what data type you wish to compare it to however I have included some stuff to hopefully help.
sub hopefullyuseful()
dim ws as worksheet
dim rng as Range
dim strlc as string
dim rc as long, i as long
dim lc as long, j as long
dim celltoprocess as range
set ws = activeworkbook.sheets(activesheet.name)
strlc = ws.cells.specialcells(xlcelltypeLastCell).address
set rng = ws.range("A1:" & lc)
rc = rng.rows.count()
debug.print "Number of rows: " & rc
lc = rng.columns.count()
debug.print "Number of columns: " & lc
'
'method 1 looping through the cells'
for i = 1 to rc
for j = 1 to lc
set celltoprocess = ws.cells(i,j)
'this gives you a cell object at the coordinates of (i,j)'
'[PROCESS HERE]'
debug.print celltoprocess.address & " is celltype: " & CellType(celltoprocess)
'here you can do any processing you would like on the individual cell if needed however this is not the best method'
set celltoprocess = nothing
next j
next i
'method 2 looping through the cells using a for each loop'
for each celltoprocess in rng.cells
debug.print celltoprocess.address & " is " & CellType(celltoprocess)
next celltoprocess
'if you just need the data in the cells and not the actual cell objects'
arrOfCellData = rng.value
'to access the data'
for i = lbound(arrOfCellData,1) to ubound(arrOfCellData,1)
'i = row'
for j = lbound(arrOfCellData,2) to ubound(arrOfCellData,2)
'j = columns'
debug.print "TYPE: " & typename(arrOfCellData(i,j)) & " character count:" & len(arrOfCellData(i,j))
next j
next i
set rng=nothing
set celltoprocess = nothing
set ws = nothing
end sub
Function CellType(byref Rng as range) as string
Select Case True
Case IsEmpty(Rng)
CellType = "Blank"
Case WorksheetFunction.IsText(Rng)
CellType = "Text"
Case WorksheetFunction.IsLogical(Rng)
CellType = "Logical"
Case WorksheetFunction.IsErr(Rng)
CellType = "Error"
Case IsDate(Rng)
CellType = "Date"
Case InStr(1, Rng.Text, ":") <> 0
CellType = "Time"
Case IsNumeric(Rng)
CellType = "Value"
End Select
end function
sub processRow(byref rngRow as range)
dim c as range
'it is unclear what you want to do with the row however... if you want
'to do something to cells in the row this is how you access them
'individually
for each c in rngRow.cells
debug.print "Cell " & c.address & " is in Column " & c.column & " and Row " & c.row & " has the value of " & c.value
next c
set c = nothing
set rngRow = nothing
exit sub
if you want your other questions answered you will have to be more specific as to what you are trying to accomplish
While I like the solution offered by #krazynhazy I believe that the following solution might be slightly shorter and closer to what you asked for. Still, I'd use the CellType function offered by Krazynhazy rather than all the Iif I currently have in the below code.
Option Explicit
Sub AllNonEmptyCells()
Dim rngRow As Range
Dim rngCell As Range
Dim wksItem As Worksheet
Set wksItem = ThisWorkbook.Worksheets(1)
On Error GoTo EmptySheet
For Each rngRow In wksItem.Cells.SpecialCells(xlCellTypeConstants).EntireRow.Rows
Call ProcessARow(wksItem, rngRow.Row)
Next rngRow
Exit Sub
EmptySheet:
MsgBox "Sheet is empty." & Chr(10) & "Aborting!"
Exit Sub
End Sub
Sub ProcessARow(wksItem As Worksheet, lngRow As Long)
Dim rngCell As Range
Debug.Print "Cells to process in row " & lngRow & ": " & wksItem.Range(wksItem.Cells(lngRow, 1), wksItem.Cells(lngRow, wksItem.Columns.Count)).SpecialCells(xlCellTypeConstants).Count
For Each rngCell In wksItem.Range(wksItem.Cells(lngRow, 1), wksItem.Cells(lngRow, wksItem.Columns.Count)).SpecialCells(xlCellTypeConstants)
Debug.Print "Row: " & lngRow, _
"Column: " & rngCell.Column, _
"Value: " & rngCell.Value2, _
IIf(Left(rngCell.Formula, 1) = "=", "Formula", IIf(IsDate(rngCell.Value), "Date", IIf(IsNumeric(rngCell.Value2), "Number", "Text")))
Next rngCell
End Sub
Note, that you have to call the sub to call a row must also include the sheet on which a row should be processed.