I'm really losing my mind with this so would appreciate anyone taking the time to help!
I suspect my problems stem from incorrect variable declaration but I haven't been able to work it out.
So why does this test procedure work:
Sub testmatch3()
Dim arr() As Variant
Dim num As Long
Dim searchVal As Variant
Dim i As Long
ReDim arr(1 To 10)
For i = 1 To 10
arr(i) = i
Next i
searchVal = 4
Debug.Print getMatch(searchVal, arr)
End Sub
Function getMatch(valueToMatch As Variant, matchArr As Variant) As Long
getMatch = Application.WorksheetFunction.Match(valueToMatch, matchArr, 0)
End Function
But the following gives me a mismatch error (Type 13):
Sub NewProcedure()
Dim ENVarr As Variant
Dim StageRange As Range
Dim cell As Range
Dim LastRow As Long
Dim i As Long
Dim ConnSheet As Worksheet
Dim tempstring As Variant
Dim arr() As Variant
Set ConnSheet = ThisWorkbook.Sheets("L1 forces")
' Find the last used row in the sheet and define the required ranges
LastRow = ConnSheet.Range("A11").End(xlDown).row
Set StageRange = ConnSheet.Range("H11:H" & LastRow)
' I have a big table of data in the "ENV sheet" which I transfer into a large 2D array
ENVarr = ThisWorkbook.Worksheets("ENV").Range("A6").CurrentRegion
' From the ENVarray, make its second column into a new 1D array
' This new array has an upper bound dimension equal to the number of rows in ENVarr
ReDim arr(LBound(ENVarr, 1) To UBound(ENVarr, 1))
For i = LBound(arr) To UBound(arr)
arr(i) = ENVarr(i, 2)
Next i
tempstring = "1140"
Debug.Print getMatch(tempstring, arr)
End Sub
Function getMatch(valueToMatch As Variant, matchArr As Variant) As Long
getMatch = Application.WorksheetFunction.Match(valueToMatch, matchArr, 0)
End Function
Just to note the value "1140" DEFINITELY exists in arr!
Thanks
I suppose in your sheet is the number 1140 and you try to match the string "1140". Did you try to write
tempstring = 1140
without quotes?
Alternatively: make sure that there is really a string in your excel sheet: ="1140" and it is not only formatted as string. The return value of =TYPE(cell) ('cell' is containing your 1140) has to be 2.
Related
Using VBA, I would like to AND across each row in a 2D array and star the result in separate 1D array without ANDing a single pair the ANDing the result with the next item in that row.
FYI This is my first time using 2D arrays so sorry if there is an obvious solution.
For example if the data in my sheet looked like this (the actual range is much larger):
I would like to do the equlavant of an excel formula: =AND(B2:D2) then =AND(B3:D3), etc...
I have code that sets everything up but I don't know how to proceed except to loop across each element of a row, store the result then loop across the next, etc, etc. I'm hoping the there is a much better (more efficient) way to proceed.
Here is my code so far
Sub Exceptions()
' Setup worksheet
Dim wks As Worksheet
Set wks = cnTest
' Find last row of range
Dim LastRow As Long
LastRow = Find_LastRow(wks) 'Functionthat returns last row
' load range into array
Dim MyArray As Variant
MyArray = wks.Range("B2:D8")
' Setup 1D Result array
Dim Results As Variant
Results = wks.Range("A2:A8")
Dim i As Long
For i = 1 To LastRow
' Perform AND function on each row of the array
' then place result in 1D array (Results())
' If this were a formul: =AND(B2:D2)
'
' Is there way to "AND" across a row in and array or
' must I "AND" MyArray(1,1) with MyArray(1,2) then AND
' that result with MyArray(1,3)
Next i
End Sub
Thank you
Try this.
Sub Exceptions()
' Setup worksheet
' load range into array
Dim MyArray As Variant
MyArray = ActiveSheet.Range("B2:D8")
' Setup 1D Result array
Dim Results As Variant
Results = ActiveSheet.Range("A2:A8")
Dim i As Long
Dim X As Long
For i = 1 To UBound(MyArray, 1)
Results(i, 1) = "True"
For X = 1 To UBound(MyArray, 2)
If MyArray(i, X) = False Then
Results(i, 1) = "False"
Exit For
End If
Next X
Next i
End Sub
Try,
Sub test()
Dim vR()
Dim rngDB As Range, rng As Range
Dim i As Long, r As Long
Set rngDB = Range("b2:b8")
r = rngDB.Rows.Count
ReDim vR(1 To r)
For Each rng In rngDB
i = i + 1
vR(i) = WorksheetFunction.And(rng.Resize(1, 3))
Next rng
Range("a2").Resize(r) = WorksheetFunction.Transpose(vR)
End Sub
In the formula bar, type:
=IF(-PRODUCT(IF(A1,-1,0),IF(C1,-1,0)),TRUE,FALSE)
(if the data is in columns A and C), and drag down.
Because, as everyone knows, A AND B = AB if A and B are Boolean variables (and watch the minus in front of the PRODUCT).
I have an array of a user-defined type and want to get data from a worksheet into this array. I have a solution but it seems inelegant. Is there a better or easier way to do this?
Type Donation
NBID As Integer
Amount As Single
DonationDate As Date
TrackingCode As String
End Type
Public dons() as Donation
Sub init()
Dim i As Integer
Dim tmpDons() As Variant
Dim donRows as Integer
tmpDons = Sheets("Appeal Dons").UsedRange.Value2
donRows = UBound(tmpDons)
ReDim dons(donRows - 2)
For i = 2 To donRows
dons(i - 2).NBID = tmpDons(i, 1)
dons(i - 2).Amount = tmpDons(i, 2)
dons(i - 2).TrackingCode = tmpDons(i, 3)
dons(i - 2).DonationDate = tmpDons(i, 4)
Next
End Sub
Try:
Option Explicit
Sub test()
Dim arr As Variant
Dim i As Long
With ThisWorkbook.Worksheets("Sheet1")
'Import to array the used range
arr = .UsedRange
'Loop from L to U arr bound
For i = LBound(arr) To UBound(arr)
'Code
Next i
End With
End Sub
I am having 2 issues that I've been trying to solve all day. First off whenever I try to watch any variable no matter what it says in the watches bar. I tried even just setting a variable to equal a number and watching it and it still gave me .
Second I am trying to put all of the values in column B that have a value into an array (TagName) and it is driving me up a wall. This is the point of the for loop. The out of context thing is not helping the case.
Just for reference "ist" was i as a string but then I added the B just to shorten the code.
Don't worry about the extra dims those are for code that is already working
Thank you for your help!
Sub GenTags()
Dim FolderPath As String
Dim OutputFileNum As Integer
Dim TagName(100) As String
Dim i As Long
Dim ist As String
Sheets("Parameters").Activate
For i = 1 To ActiveWorkbook.ActiveSheet.Columns("B").End(xlDown).Row
ist = "B" & CStr(i)
TagName(i) = ActiveWorkbook.Sheets("Parameters").Range(ist)
Next
End Sub
If you only want cells with values, you should probably have that as part of your loop. I think this should work. I also changed the array to be a variant in case you have a mix of string and numbers.
Sub GenTags()
Dim FolderPath As String
Dim OutputFileNum As Integer
Dim TagName(100) As Variant
Dim i As Long, c As Long
Dim ist As String
Sheets("Parameters").Activate
For i = 1 To ActiveWorkbook.ActiveSheet.Columns("B").End(xlDown).Row
If Not IsEmpty(Range("B" & i)) Then
TagName(c) = Range("B" & i).Value
c = c + 1
End If
Next
End Sub
This approach is a little more granular and takes care of empty cells in the column.
It's easy just yo customize the ">>>>" section
Sub GenTags()
Dim FolderPath As String
Dim OutputFileNum As Integer
Dim ist As String
' Define object variables
Dim sourceSheet As Worksheet
Dim paramSheet As Worksheet
Dim sourceRange As Range
Dim cellEval As Range
' Define other variables
Dim sourceSheetName As String
Dim paramSheetName As String
Dim sourceColumn As String
Dim tagName() As Variant
Dim counter As Long ' before i
Dim nonBlankCounter As Long
Dim totalCells As Long
' >>> Customize to fit your needs
sourceSheetName = "Sheet1"
paramSheetName = "Parameters"
sourceColumn = "B"
' Initialize objects - Change sheets names
Set sourceSheet = ThisWorkbook.Worksheets(sourceSheetName)
Set paramSheet = ThisWorkbook.Worksheets(paramSheetName)
Set sourceRange = Application.Union(sourceSheet.Columns(sourceColumn).SpecialCells(xlCellTypeConstants), sourceSheet.Columns(sourceColumn).SpecialCells(xlCellTypeFormulas))
' Get how many items in column b are
totalCells = sourceRange.Cells.Count
' Redimension the array to include all the items
ReDim tagName(totalCells)
' Initilize the counter (for documentation sake)
counter = 0
For Each cellEval In sourceRange
' Add non empty values
If Trim(cellEval.Value) <> vbNullString Then
' Store it in the array
tagName(counter) = cellEval.Value
counter = counter + 1
End If
Next cellEval
' Redim to leave only used items
ReDim Preserve tagName(counter - 1)
End Sub
Let me know if it helps!
Thank you for your responses. Unfortunatley I had to put this project on the back burner until yesterday but I did try both answers and they didn't work. I decided to go a different direction with the entire code and got it working. Thank you for your help and sorry for the late response.
Is there any possible way to take a list of items or names, such as:
Apples
Oranges
Grapes
Watermelons
And have Excel double that information and sequentially number it, like this:
Apples1
Apples2
Oranges1
Oranges2
Grapes1
Grapes2
Watermelons1
Watermelons2
I know a little bit of VBA but I can't wrap my head around how I would even start this.
You can specify where you want to read, and where you want to start write and how many times you want to repeat!
Just change the code:
Sub DoRepeat()
Dim repeatTimes As Integer
Dim rng As Range, cell As Range
repeatTimes = 2
Set cellsToRead = Range("A1:A3")
Set cellStartToWrite = Range("B1")
For Each cell In cellsToRead
For i = 1 To repeatTimes
cellStartToWrite.Value = cell.Value + CStr(i)
Set cellStartToWrite = Cells(cellStartToWrite.Row + 1, cellStartToWrite.Column)
Next
Next cell
End Sub
As it seems it is required to have a more dynamic approach, try this out. The DoubleNames function will return the names duplicated N number of times specified in the DuplicateCount parameter. It will return a Collection, which you can easily dump to a range if need be.
Public Function DoubleNames(ByVal DataRange As Excel.Range, DuplicateCount As Long) As Collection
Set DoubleNames = New Collection
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
Dim i As Long
Dim DataItem As Excel.Range
Set DataRange = DataRange.SpecialCells(xlCellTypeConstants)
For Each DataItem In DataRange
For i = 1 To DuplicateCount
If Not dict.Exists(DataItem.Value) Then
DoubleNames.Add (DataItem.Value & "1")
dict.Add DataItem.Value, 1
Else
dict(DataItem.Value) = dict(DataItem.Value) + 1
DoubleNames.Add (DataItem.Value & dict(DataItem.Value))
End If
Next
Next
End Function
Sub ExampleUsage()
Dim item As Variant
Dim rng As Range: Set rng = ThisWorkbook.Sheets("Sheet1").Range("A1:A5")
For Each item In DoubleNames(rng, 5)
Debug.Print item
Next
End Sub
I would start by writing a general function that outputs the names (passed as a variant array) a given number of times:
Public Sub OutputNames(ByVal TimesToOutput As Integer, ByRef names() As Variant)
Dim nameIndex As Integer, outputIndex As Integer
For nameIndex = LBound(names) To UBound(names)
For outputIndex = 1 To TimesToOutput
Debug.Print names(nameIndex) & outputIndex
Next outputIndex
Next nameIndex
End Sub
Here you can see the sub that tests this:
Public Sub testOutputNames()
Dim names() As Variant
names = Array("Apples", "Oranges", "Grapes", "Watermelons")
OutputNames 2, names
End Sub
which gives you this output:
Apples1
Apples2
Oranges1
Oranges2
Grapes1
Grapes2
Watermelons1
Watermelons2
First time poster so please excuse any faux pas.
I am trying to write a macro in Excel that iterates through about 1000 rows of a sheet ("PLANNING BOARD") and compares the value in column F to a value in column A of another worksheet ("Copy") that contains 500 rows and 20+ columns (values to be compared are integers). If there is a match, I want the entire row to be deleted from the second worksheet and the rows below to be shifted up. I got a linear search to work, but it is very slow, so I am trying implement a binary search.
Here is the binary search function I have:
Function BinarySearch(lookupArray As Variant, lookupValue As Variant) As Integer
Dim intLower As Integer
Dim intMiddle As Integer
Dim intUpper As Integer
intLower = LBound(lookupArray) 'type mismatch error here
intUpper = UBound(lookupArray)
Do While intLower < intUpper
intMiddle = (intLower + intUpper) \ 2
If lookupValue > lookupArray(intMiddle) Then
intLower = intMiddle + 1
Else
intUpper = intMiddle
End If
Loop
If lookupArray(intLower) = lookupValue Then
BinarySearch = intLower
Else
BinarySearch = -1 'search does not find a match
End If
End Function
And the calling subroutine:
Sub Compare()
Dim h As Integer
For h = 1 To 1000 'iterate through rows of PLANNING BOARD
If Sheets("PLANNING BOARD").Cells(h, 6) <> "" Then 'I want to ignore blank cells
Dim i As Integer
i = BinarySearch(Sheets("Copy").Range("A:A"), Sheets("PLANNING BOARD").Cells(h, 6))
If i <> -1 Then
'delete row and shift up
Sheets("Copy").Rows(i).EntireRow.Delete Shift:=xlUp
End If
End If
Next h
End Sub
I think there is a problem with the lookupArray that I am passing to the BinarySearch function in the Compare subroutine because I keep getting a type mismatch error when passing the lookupArray to VBA's LBound and UBound functions. Any insight will be greatly appreciated. Thanks.
I assume your Copy sheet is sorted on column A.
You need to use Long rather than Integer for all your Dim statements.
Also your routine is being extremely inefficient by reading an entire column and then passing it to your binary search routine. Try only passing a the range that actually has any data in it. (You can use either End(Xlup) from below the data or work with the UsedRange).
Lookup Array is 2-dimensional not 1
You need to make sure you have converted the range to a variant array
You can debug this by using the Locals window to determine the type of LookupArray.
Here is an improved version of your code:
Option Explicit
Function BinarySearch(lookupArray As Variant, lookupValue As Variant) As Long
Dim intLower As Long
Dim intMiddle As Long
Dim intUpper As Long
intLower = LBound(lookupArray)
intUpper = UBound(lookupArray)
Do While intLower < intUpper
intMiddle = (intLower + intUpper) \ 2
' lookupArray is 2-dimensional
If lookupValue > lookupArray(intMiddle, 1) Then
intLower = intMiddle + 1
Else
intUpper = intMiddle
End If
Loop
If lookupArray(intLower, 1) = lookupValue Then
BinarySearch = intLower
Else
BinarySearch = -1 'search does not find a match
End If
End Function
Sub Compare()
Dim h As Long
Dim rngSearched As Range
Dim lCalcmode As Long
Dim i As Long
Application.ScreenUpdating = False
lCalcmode = Application.Calculation
Application.Calculation = xlCalculationManual
For h = 1000 To 1 Step -1 'iterate backwards through rows of PLANNING BOARD
If Sheets("PLANNING BOARD").Cells(h, 6).Value2 <> "" Then 'I want to ignore blank cells
' minimise area being searched
Set rngSearched = Sheets("Copy").Range("A1:A" & Sheets("Copy").Range("A1048576").End(xlUp).Row)
i = BinarySearch(rngSearched.Value2, Sheets("PLANNING BOARD").Cells(h, 6).Value2)
If i <> -1 Then
' delete row and shift up
Sheets("Copy").Rows(i).EntireRow.Delete Shift:=xlUp
End If
End If
Next h
Application.ScreenUpdating = True
Application.Calculation = lCalcmode
End Sub
When the range being passed to the function BinarySearch(), it is not of type Variant; You can however convert it simply by assigning to one. Please try the following:
Under your function BinarySearch,
Dim intLower As Integer
Dim intMiddle As Integer
Dim intUpper As Integer
dim temparry as Variant
temparry = lookupArray
intLower = LBound(temparry)
Same for all other use for lookupArray.