Finding different numbers with same digits from an array [closed] - vba

Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 7 years ago.
Improve this question
I have an array of 6 digit numbers in which I need to find numbers with same digits but with different order. How can I do this in vba?

I feel a good way to do this would be to take your 6 digit number, create an array containing those 6 digits, sort them, then give you the new number (returned as a string in this example) then compare the two to make sure they are equal.
Public Function SortNumber(intIn As Long)
Dim intArr(1 To 6) As Integer, strResult As String
Dim i As Integer
For i = 1 To 6
intArr(i) = Mid(CStr(intIn), i, 1)
Next i
BubbleSort intArr
For i = 1 To 6
strResult = strResult + CStr(intArr(i))
Next i
SortNumber = strResult
End Function
Function BubbleSort(TempArray As Variant)
Dim Temp As Variant
Dim i As Integer
Dim NoExchanges As Integer
Do
NoExchanges = True
For i = 1 To UBound(TempArray) - 1
If TempArray(i) > TempArray(i + 1) Then
NoExchanges = False
Temp = TempArray(i)
TempArray(i) = TempArray(i + 1)
TempArray(i + 1) = Temp
End If
Next i
Loop While Not (NoExchanges)
End Function

Related

Extract only first available numeric in a string [closed]

Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 7 months ago.
Improve this question
For an example if column value is "ABC 123 981" need to extract only 123... like so if its "456_wert" need to extract only 456 using access VBA code. Can somebody please help on this.
Parse First Consecutive Digits
Sub StrFirstDigitsTEST()
Const pString As String = "a123.456b"
Dim rString As String: rString = StrFirstDigits(pString)
Debug.Print rString, Len(rString)
' Result:
' 123 3
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Returns a string's ('ParseString') first consecutive digits
' in a string.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function StrFirstDigits(ByVal ParseString As String) As String
Dim ResultString As String
Dim Char As String
Dim FoundDigit As Boolean
Dim n As Long
For n = 1 To Len(ParseString)
Char = Mid(ParseString, n, 1)
If Char Like "#" Then
If Not FoundDigit Then FoundDigit = True
ResultString = ResultString & Char
Else
If FoundDigit Then Exit For
End If
Next n
StrFirstDigits = ResultString
End Function
Parsing strings is fairly simple if data has a consistent structure. Does not seem to be the case here so gets complicated. Your second example could be accomplished with Val("456_wert") but because the first example does not follow same pattern, will require more complex code. Probably have to test each character until a number is encountered. Based on samples provided, something like:
Function GetNumber(varS As Variant) As Variant
Dim x As Integer
GetNumber = Null
If varS & "" Like "*#*" Then
For x = 1 To Len(varS)
If IsNumeric(Mid(varS, x, 1)) Then
GetNumber = Val(Mid(Replace(varS, " ", "|"), x))
Exit For
End If
Next
End If
End Function
Place the procedure in a general module and call it from query or textbox.
SELECT table.*, GetNumber([source field]) AS Nbr FROM table;
=GetNumber([sourcefield])
Shouldn't really be necessary to populate a field in table with this extract, however, the SQL would be:
UPDATE tablename SET fieldname = GetNumber([source field])

Why am I receiving an index out of range exception on my insertion sort? [closed]

Closed. This question does not meet Stack Overflow guidelines. It is not currently accepting answers.
Closed 5 years ago.
This question was caused by a typo or a problem that can no longer be reproduced. While similar questions may be on-topic here, this one was resolved in a way less likely to help future readers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Improve this question
This insertion sort is for sorting the array into ascending order, when it attempt to do so I receive an index out of range exception, when this happens "j" is 0 and "i" is 1. It tries to compare the value in the first element to the value in the element with an index of "-1" which doesn't exist. What changes can I make to make this code functional?
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
Dim i, j, element, length As Integer
Dim array(7) As Integer
array(0) = 5
array(1) = 2
array(2) = 7
array(3) = 6
array(4) = 9
array(5) = 1
array(6) = 4
array(7) = 8
length = array.Length
For i = 1 To length - 1
j = i
While j > 0 And array(j) < array(j - 1)
If array(j - 1) > array(j) Then
element = array(j)
array(j) = array(j - 1)
j = j - 1
array(j) = element
End If
End While
Next
For Index As Integer = 0 To 7
ListBox1.Items.Add(array(Index))
Next
End Sub
Your line saying
While j > 0 And array(j) < array(j - 1)
will give an index out of range error whenever j is zero (because j - 1 will be -1 and you don't have a array(-1) element).
Change that line to
While j > 0 AndAlso array(j) < array(j - 1)
so that the second part of the test is only evaluated if the first part is True.

how to relay on a number in a cell and list columns based on that number in vba [closed]

Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 5 years ago.
Improve this question
Basically, I have list of credits in a spreadsheet. Each credit heading on the sheet is displayed as Credit(5) and it displays below that 5 credits i.e:
Credit(5)
Cre1
Cre2
Cre3
Cre4
Cre5
Then I have another heading with Credit(3) and that displays 3 credits below it i.e:
Credit(3)
Cre1
Cre2
Cre3
Now my question is how to do this in VB and relay on the numbers (3) and (5) and display below the heading list according to the number in the heading? so in other words have 5 columns below the heading if heading has (5) and 3 for the other one.
Something like this? Credit to paxdiablo here. Edited.
Private Sub CommandButton1_Click()
Dim sTitle As String
Dim openPos As Integer
Dim closePos As Integer
Dim midBit As Integer
Dim i As Integer
Dim k As Integer
For k = 1 To 50
sTitle = Worksheets("Sheet1").Cells(1, k)
If sTitle <> "" Then
openPos = InStr(sTitle, "(")
closePos = InStr(sTitle, ")")
midBit = Mid(sTitle, openPos + 1, closePos - openPos - 1)
For i = 1 To midBit
Worksheets("Sheet1").Cells(i + 1, k) = "cre" & i
Next i
End If
Next k
End Sub

Visual Basic Textbox Content Restrictions [closed]

Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 7 years ago.
Improve this question
How can I restrict a textbox to only accept lowercase letters with one uppercase letter, or at least 1 uppercase letter and a number?
To check if a string contains at least one upper character, one lower character and one number, you can use the Char.IsUpper / IsLower / IsNumber methods.
Private Function IsValidPasswordFormat(ByVal text As String) As Boolean
If String.IsNullOrEmpty(text) Then
Return False
End If
If text.Any(Function(c) Char.IsUpper(c)) AndAlso
text.Any(Function(c) Char.IsLower(c)) AndAlso
text.Any(Function(c) Char.IsNumber(c)) Then
Return True
End If
Return False
End Function
suppose that str is the textbox.text
Dim ucount as integer
ucount=0
For Each c As Char In str
Dim charCode As Integer = AscW(c)
If charCode >= 65 AndAlso charCode < 91 Then
ucount += 1
End If
Next
if ucount>1
'do something
End If
In the do something part, for example you can put textbox.text=""

Converting from VBA to VB.NET [closed]

Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 8 years ago.
Improve this question
I'm trying to convert this little code from Vba to Vb.net without success.
Would like some help please.
Dim str As String, i As Long
For i = 0 To lstPages.ListCount - 1
If lstPages.Selected(i) Then
If str <> vbNullString Then str = str & "-"
str = str & lstPages.List(i)
End If
Next
So you want the third column, from all selected rows of the ListView, in one string separated by "-"?
Yes that's right.
Then do:
Dim values As New List(Of String)
For Each lvi As ListViewItem In lstPages.SelectedItems
values.Add(lvi.SubItems(2).Text)
Next
Dim str As String = String.Join("-", values)
Debug.Print(str)
I think you could do something like this:
For i as integer = 0 To lstPages.ListCount - 1
If lstPages.Selected(i) Then
If Not String.IsNullOrEmpty(str) Then
str &= "-"
str &= lstPages.List(i)
End If
Next