I have one column array that I'm selecting from a SQL Server, this column is sometimes ascending sorted and sometimes not.
The database I'm selecting from is set to Hebrew_CI_AS collation, and the data in the column contains Hebrew text, English text and wildcards.
In my VBA sub I have this code that should check rather the "ArrayThatReturnsFromSQL" variable is ascending sorted or not.
Sub MySub
Dim ArrayThatReturnsFromSQL as Variant
Dim IsArraySorted as Boolian
'One column array
ArrayThatReturnsFromSQL = ThisFunctionReturnsArrayFromSQL
IsArraySorted = IsArrSortedAsc(ArrayThatReturnsFromSQL)
End Sub
Public Function IsArrSortedAsc(Arr As Variant) as Boolean
Dim aRw As Long
Dim Ub As Long
Dim tmpBool As Boolean
Ub = UBound(Arr)
tmpBool = True
If Ub > 0 Then
For aRw = 1 To Ub
If Arr(aRw) < Arr(aRw - 1) Then
tmpBool = False
Exit For
End If
Next
End If
IsArrSortedAsc = tmpBool
End Function
My IsArrSortedAsc is always returns FALSE even after an "ORDER BY ASC" clause, and I think it's because my Hebrew_CI_AS collation.
I think I can solve it by adding a ORDER BY FieldName COLLATE ????????, but I don't know what is the VBA "Collation"...
So my question is, what Collation I need to use in the SQL that is similar to the way the VBA ordering is working ?
EDIT:
Ok, I managed to isolate the issue, try the following code, it is clearly a VBA bug.
Sub Test()
Dim STR1 As String
Dim STR2 As String
'Reminder, Hebrew is written from right to left
'so STR1 should be less then STR2
STR1 = "א'"
STR2 = "'א"
'this return 1 it means that string1 is greater than string2, and it's wrong.
Debug.Print StrComp(STR1, STR2, vbTextCompare)
End Sub
Any ideas ?
Related
I have a column full of data in a format I don't like, and need them in another format. Currently they are formatted like this: "190826_095630_3E_1 (ROI 0)" and I need just the "3E" portion. I have written a string split that uses the "_" and I figure I can then just take the column of data that is produced that I want, however I can only get this to work one cell at a time while I click each one. I tried to write a for loop but I am running into trouble, most likely because I used "active.cell". Does anyone have a better way to loop this split through my column? Alternatively if you also know how to just return the third string split (3E) I would really appreciate it.
'No loop: This works for one cell
Option Explicit
Sub NameTest()
Dim txt As String
Dim i As Integer
Dim FullName As Variant
txt = ActiveCell.Value
FullName = Split(txt, "_")
For i = 0 To UBound(FullName)
Cells(1, i + 1).Value = FullName(i)
Next i
End Sub
'Attempt at a loop:
Option Explicit
Sub NameTest()
Dim txt As String
Dim i As Integer
Dim FullName As Variant
Dim x As Integer
For x = 1 To 1000
txt = ActiveCell.Value
FullName = Split(txt, "_")
For i = 0 To UBound(FullName)
Cells(1, i + 1).Value = FullName(i)
Next i
Next x
End Sub
I would like to get this to run until the last cell with data in a given column.
My Goal is to take two rows(FirstName and Surname) Convert them to a single Array of "FirstName, Surname".
This is my terrible code i eventually put together
Private Sub Search_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'TODO: This line of code loads data into the 'DbaPatientDataSet.tblPatientData' table. You can move, or remove it, as needed.
Me.TblPatientDataTableAdapter.Fill(Me.DbaPatientDataSet.tblPatientData)
listFirst.DataSource = Me.TblPatientDataBindingSource
listFirst.DisplayMember = "FirstName"
listLast.DataSource = Me.TblPatientDataBindingSource
listLast.DisplayMember = "Surname"
Dim Lenth As Integer = Me.listFirst.Items.Count - 1
Dim count As Integer = 1
Dim ArrFirst(Lenth) As String
Dim ArrLast(Lenth) As String
For count = 1 To Lenth
ArrFirst(count) = listFirst.Items(count).ToString
ArrLast(count) = listLast.Items(count).ToString
Next count
count = 1
For count = 1 To Lenth
arrFullName(count) = ArrLast(count) & ", " & ArrFirst(count)
Next count
'Arrays Set =====================================================
But with this code i get an Array of
`"Sytem.Data.DataRowView, Sytem.Data.DataRowView"
"Sytem.Data.DataRowView, Sytem.Data.DataRowView"
"Sytem.Data.DataRowView, Sytem.Data.DataRowView"
"Sytem.Data.DataRowView, Sytem.Data.DataRowView"
`
As you can see
Here
There must be an easy way to convert both DataRows to strings then concatenate them together in an array
I am going to search this array using a Binary Search to find a desired name
Thanks
First, I think you are confusing your rows and your columns. You have 2 columns. I went directly to full name but I think you can break it out if you need to.
Dim arrNames(ListBox1.Items.Count - 1) As String
For i As Integer = 0 To ListBox1.Items.Count - 1
arrNames(i) = $"{ListBox1.Items(i)} {ListBox2.Items(i)}"
Next
For Each item In arrNames
Debug.Print(item)
Next
The string with the $ in front is an interpolated string. Sort of an improvement to String.Format.
I know there is an answer but for now you could go direct to the data table to get what you need.
Dim arrNames(ListBox1.Items.Count - 1) As String
Dim i As Integer = 0
Dim dt As DataTable = DbaPatientDataSet.Tables(0)
For Each row As DataRow In dt.Rows
arrNames(i) = $"{row("Surname")}, {row("FirstName")}"
i += 1
Next
For Each item In arrNames
Debug.Print(item)
Next
'assume the names of your columns are Surname and FirstName
If I run your code up, I get the result you are looking for, so I'm not sure what you are missing. In saying that though, you are making things hard on yourself by messing around with arrays :). Just use the dataset rows directly - they are strongly typed and you can check for nulls etc as needed... something like this;
Dim fullNames As New List(Of String) '-- or you could fill your array.
For Each row As DbaPatientDataSet.tblPatientDataRow In ds.tblPatientData
fullNames.Add(row.Surname & ", " & row.FirstName)
Next
Just looking at what you are trying to achieve, if it was me, I would be bringing back the formatted data in my query that fills the dataset i.e. a third, FullName, column.
It has been in the back of my mind. Finally got it for the List Box directly.
Dim arrFullNames(ListBox1.Items.Count - 1) As String
Dim i As Integer = 0
For Each item As DataRowView In ListBox1.Items
arrFullNames(i) = $"{DirectCast(item("Surname"), String)}, {DirectCast(item("Firstname"), String)}"
i += 1
Next
For Each item As String In arrFullNames
Debug.Print(item)
Next
Problem: I am comparing two columns of names. If a name from the primary column matches a name in the secondary column, then I would like to add the matching name to an array of strings.
Function 1: This boolean function should indicate whether there is a match:
Function Match(name As String, s As Worksheet, column As Integer) As Boolean
Dim i As Integer
i = 2
While s.Cells(i, column) <> ""
If s.Cells(i, column).Value = name Then
Match = True
End If
i = i + 1
Wend
Match = False
End Function
Function 2: This function should add the matching name to a dynamic array of strings. Here I am somewhat stuck as I am new to arrays- any suggestions?
Function AddToArray(ys) As String()
Dim a() As String
Dim size As Integer
Dim i As Integer
Dim sh As Worksheet
Dim rw As Range
size = 0
ReDim Preserve a(size)
For Each rw In sh.Rows
If Match(sh.Cells(rw.Row, 1), s, column) = True Then
??
size = size + 1
End Function
Here is one solution. I scrapped your Match function and replaced it with a Find function.
Option Explicit
Sub AddToArray()
Dim primaryColumn As Range, secondaryColumn As Range, matchedRange As Range
Dim i As Long, currentIndex As Long
Dim matchingNames As Variant
With ThisWorkbook.Worksheets("Sheet1")
Set primaryColumn = .Range("A1:A10")
Set secondaryColumn = .Range("B1:B10")
End With
'Size your array so no dynamic resizing is necessary
ReDim matchingNames(1 To primaryColumn.Rows.Count)
currentIndex = 1
'loop through your primary column
'add any values that match to the matchingNames array
For i = 1 To primaryColumn.Rows.Count
On Error Resume Next
Set matchedRange = secondaryColumn.Find(primaryColumn.Cells(i, 1).Value)
On Error GoTo 0
If Not matchedRange Is Nothing Then
matchingNames(currentIndex) = matchedRange.Value
currentIndex = currentIndex + 1
End If
Next i
'remove unused part of array
ReDim Preserve matchingNames(1 To currentIndex - 1)
'matchingNames array now contains just the values you want... use it how you need!
Debug.Print matchingNames(1)
Debug.Print matchingNames(2)
'...etc
End Sub
Extra comments
There is no need to create your own Match function because it already exists in VBA:
Application.Match()
WorksheetFunction.Match()
and as I mentioned above you can also achieve the same result with the Find function which is my preference here because I prefer the way you can check for no matches (other methods throw less convenient errors).
Finally, I also opted to restructure your code into one Sub rather than two Functions. You weren't returning anything with your AddToArray function which pretty much means by definition it should actually be a Sub
As I stated in a comment to the question, there are a couple of problems in your code before adding anything to the array that will prevent this from working, but assuming that this was caused by simplifying the code to ask the question, the following should work.
The specific question that you are asking, is how to populate the array while increasing its size when needed.
To do this, simply do this:
Instead of:
ReDim Preserve a(size)
For Each rw In sh.Rows
If Match(sh.Cells(rw.Row, 1), s, column) = True Then
Reorder this so that it is:
For Each rw In sh.Rows
If Match(sh.Cells(rw.Row, 1), s, column) = True Then
ReDim Preserve a(size) 'increase size of array
a(size) = sh.Cells(rw.Row,1) 'put value in array
size = size + 1 'create value for size of next array
End If
Next rw
....
This probably isn't the best way to accomplish this task, but this is what you were asking to do. First, increasing the array size EVERY time is going to waste a lot of time. It would be better to increase the array size every 10 or 100 matches instead of every time. I will leave this exercise to you. Then you could resize it at the end to the exact size you want.
I modified the VBA code found at
checking if value present in array to the code below. A user will choose a field name and I want the code to find the column that field is listed in and create an array of all items in that column, but I want each non-blank value to show up only once in the array. I don't want any duplicates.
For example, if the column has values A, B, A, C, D, I want the code to return the array as A, B, C, D.
I get a run time error 13 - Type mismatch on this line of the code:
If cell.Value <> "" And IsError(WorksheetFunction.Match(cell.Value, MyArray, 0)) Then
I'm confused, because it seems like all my data types are correct. Can anyone offer any help?
Sub ChangeBlock()
Dim MyArray() As String
Dim cell As Range
Dim ColNum As Integer
Dim i As Integer
If Not Intersect(ActiveCell, Range("Block1")) Is Nothing Then
If ActiveCell.Value = "" Then Exit Sub
ColNum = WorksheetFunction.Match(ActiveCell.Value, Sheets("Budget Table").Range("A1:AG1"), 0)
For Each cell In Sheets("Budget Table").Columns(ColNum)
If cell.Value <> "" And IsError(WorksheetFunction.Match(cell.Value, MyArray, 0)) Then
ReDim Preserve MyArray(i)
MyArray(i) = cell.Value
i = i + 1
End If
Next
End If
MsgBox (MyArray)
End Sub
To use IsError, use Application.Match instead of WorksheetFunction.Match.
Although these two methods are similar, the way they handle errors is slightly different. The former returns an error variant that you can test with IsError, while the latter just throws an error that you can only catch with an error-handling mechanism.
Finally, if your data is large, this is not the optimal way to do the checking for duplicates; you should think of using a Dictionary.
The Error 13 Type mismatch is caused here:
cell.Value <> ""
The Value here is 2D-array something like (1 To 1048576, 1 To 1) and it is not possible to compare this array to a string hence the type mismatch.
Edit:
Actually the variable cell is a column so to compare properly it is necessary to say what element of the array is compared, e.g. for the first element:
cell.Value()(1, 1) = ""
More correct would be to rename the variable cell to e.g. oneColumn because the variable cell actually contains a reference to a column, e.g. like this:
Dim myColumns As Range
Set myColumns = Sheets("Budget Table").Columns(ColNum)
Dim oneColumn As Range
For Each oneColumn In myColumns
' ...
Next oneColumn
Note: Here the for-each does not make sense because myColumns references just one column and myColumns.Columns.Count returns 1. So all you wanted was actually myColumns.Cells which returns all the cells of the column.
The value of oneColumn is 2D-array and to be honest I don't know why it is 2D and not just 1D either. When you would examine Value of e.g. Range("A1:C3") then you see it returns 2D-array which is understandable. But why one column of columns returns 2D as well? Seems to be odd to me as well :). An example of 1D-array would be Dim oneDArray: oneDArray = Array("A", "B", "C"). As far as I know 1D-array is never returned from a Range.Value property. Here interesting article about array dimensions in VBA.
But this is not necessary because each Range has a property Cells. So here the Columns(ColNum).Cells should be used.
The complete code could look something like the following but it is a little bit too complicated. First the array has a lot of empty elements because the whole column is used and second consider the solution with a dictionary like #A.S.H is proposing. HTH
Dim MyArray() As String
Dim cell As Range
Dim ColNum As Integer
Dim i As Integer
ReDim MyArray(0 To 0)
With Sheets("Budget Table")
If Intersect(ActiveCell, .Range("Block1")) Is Nothing Then _
Exit Sub
If ActiveCell.Value = "" Then _
Exit Sub
ColNum = Application.Match(ActiveCell.Value, .Range("A1:AG1"), 0)
For Each cell In .Columns(ColNum).Cells
If cell.Value = "" Then _
GoTo continue
If IsError(Application.Match(cell.Value, MyArray, 0)) Then
If i > 0 Then
ReDim Preserve MyArray(i)
End If
MyArray(i) = cell.Value
i = i + 1
End If
continue:
Next cell
End With
First off, I appreciate any help anyone can offer. I am writing a macro that will give the user a form to input a number key. The form will search a spreadsheet for the key and return the corresponding name attached to that key. The data may have multiple names per key and it will vary depending on the key. I want to loop through the data with .Find and .FindNext, and find all the possible names attached to that key (i have accomplished this part). The part I am having trouble with is during the loop, storing each name in an array that I can pass to another sub. I want to pass the array so that the user can click another command button and cycle through the possible names before choosing one.
Private Sub FindNameButton_Click()
Dim KeyMatch As Long
Dim NameRow As Long
FindName As Range
KeyMatch = KeyBox.Value ' The UserForm input box
With Worksheets("Master List"). Range("D:D")
Set FindName = .Find(What:= KeyMatch, LookAt:= xlWhole, LookIn:= xlValues, MatchCase:= False)
If not FindName Is Nothing Then
FirstAddress = FindName.Address
Do
Application.GoTo FindName
NameRow = ActiveCell.Row
Cells(NameRow, 2).Select 'Selects the name associated with the key identifier
NameBox.Value = ActiveCell.Value 'Fills the UserForm box with the name
' I would like to fill the array here with each name is it passes through but I have no idea how
NameArray(i) = ActiveCell.Value ' ??????
Set FindName = .FindNext(FindName)
Loop While FindName is Nothing and FristAddress <> FindName.Address
End With
End Sub
Private Sub NextNameButton_Click()
Static cnt As Long
If cnt <= Ubound(NameArray) Then
NameBox.Value = NameArray(cnt) 'Fill UserForm Name Box with name from Name Array
Else
cnt = 0
End If
cnt = cnt + 1 ' increase every time button is clicked
End Sub
Your question could use additional details about the problem. A few things I noticed.
You are missing an 'End If' for 'If not FindName Is Nothing Then'
NameArray isn't passed out or into your subroutines. Have you decared NameArray as global?
NameArray needs to be declared as a dynamic array: Dim NameArray() As Variant.
You need to use 'Redim Preserve NameArray(newIndxBound)' to increase the size of an array.
I recommend using 'Option Explicit' to make sure all your variables have been defined.
You might consider using the function StrCmp for string comparison instead of 'FristAddress <> FindName.Address'.
This bit of code that used a global dynamic array might help you out.
Option Explicit
Public MyArray() As Variant
Sub AddToArray()
Dim indx As Integer
For indx = 0 To 9
ReDim Preserve MyArray(indx)
MyArray(indx) = indx
Next indx
End Sub
Sub RetrieveFromArray()
Dim indx As Integer
Dim sht As Worksheet
Dim rowN As Integer
Set sht = ActiveSheet
rowN = 10
For indx = 0 To 9
sht.Cells(rowN, 3) = MyArray(indx)
rowN = rowN + 1
Next indx
End Sub