Building and coding a program to draw a rectangle of asterisks in visual basic - vba

I am trying to build a for loop that greats a rectangle with asterisks where a user can enter the number of rows and columns they would wish displayed. I am able to get the rows working correctly but I unable to get the columns to work as they should. Could anyone correct me on where am going wrong:
Private Sub cmdProcess_Click(sender As Object, e As EventArgs) Handles cmdProcess.Click
Dim rows As Integer
Dim columns As Integer
rows = txtRow.Text
columns = txtColumn.Text
lbloutput.Text = ""
For i = 1 To rows
lbloutput.Text = lbloutput.Text & "*" & vbCrLf
Next
End Sub

Before anything else: your code will error if the user enters a negative number, or 0. Unless you have any other code to address this, you might want to try something like this:
rows = Abs(cInt(txtRow.Text))
columns = Abs(cInt(txtColumn.Text))
if rows*columns < 1 Then Exit Sub
(If your code is in VBA, rather than VB, then there is no advantage to using Integer over Long, as they both use the same amount of memory — an Integer just locks half of it out as unusable)
A naïve approach would be to use two loops, like so:
lbloutput.Text = ""
For i = 1 To rows 'How many lines of text?
For j = 1 to columns 'How many asterisks per line?
lbloutput.Text = lbloutput.Text & "*"
Next j
lbloutput.Text = lbloutput.Text & vbCrLf
Next i
However, a simpler method would be to use the String function:
lbloutput.Text = ""
For i = 1 To rows
lbloutput.Text = lbloutput.Text & String(columns, "*") & vbCrLf
Next i

Related

Q. Accept two numbers using an InputBox in two different variables and print the sum of two in a message box. (Visual Basic)

I have to answer this in Visual Basic.I actually don't have any idea how to solve this, our teacher barely teaches us practical stuff. I have to submit this assignment by today too.
I have tried to do solve it and searched the internet for it, but I could barely understand it.
Here is some code you can build upon:
Public Sub AddTwoNumbers()
Dim FirstNumber As String = Convert.toInt32(InputBox("Enter the first number.")) 'Get the first number
Dim SecondNumber As String = Convert.toInt32InputBox("Enter the second number.")) 'Get the second number
Dim Result As Integer = 0 'Used to store the result in
'Now perform the calculation.
Result = FirstNumber + SecondNumber
'Then show the result in a MessageBox
MessageBox.Show("The result is: " & Result.ToString())
End Sub
Here's an example using Integer.TryParse():
Dim value1, value2 As Integer
Dim response As String = InputBox("Enter first Integer:")
If Integer.TryParse(response, value1) Then
response = InputBox("Enter second Integer:")
If Integer.TryParse(response, value2) Then
Dim sum As Integer = value1 + value2
MessageBox.Show("The sum of " & value1 & " and " & value2 & " is " & sum)
Else
MessageBox.Show(response & " is not a valid Integer!")
End If
Else
MessageBox.Show(response & " is not a valid Integer!")
End If

VBA - Struggling with worksheet_change. Not working with no error given

I have a sheet in which our wholesale team are to enter L09 Part Codes and quickly see how much we have in stock of that item. The problem is that new starters may struggle to learn these part numbers as they don't follow a simple rule. What I did was create an easier code to remember which is simply: "Cable Type" & "Core Size" & "Cut Length", they also have the option to add "Colour" and "Brand" separated by spaces.
Their entered string may look like 6242y 2.5 100, or maybe 6242y 2.5 100 Grey, etc. and so where to look in my mapped table for what they've written depends on how many terms they put in. As you can see from the attached picture I need to select the correct column to look in for their code, and then offset back a few columns to suggest the correct L09 Part Number.
I hope the context makes a bit of sense and helps with the below code. The idea was for a new starter to enter something simple and it be replaced before their very eyes...
If anyone could help me to correct the following it would be greatly appreciated:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim P, Products, S, Search As Range
Dim Column As String
Dim Counter As Integer
Dim Spaces As Long
'On Error Resume Next
Counter = 0
'For top table only
If Target.Column = 1 And Target.Row < 100 Then
'Count spaces
Spaces = UBound(Split(Target, " "), 1)
Select Case Spaces
Case Is = 2
Column = "M"
Case Is = 3
Column = "O"
Case Is = 4
Column = "Q"
End Select
'When string has spaces
If Spaces <> 0 Then
'Set simple code range
Set Search = Sheets("Cherries").Range(Column & 1 & ":" & Column & 10000)
For Each S In Search
If S = Target Then
Target = S.Offset(0, 3 - 2 * Spaces)
End If
Next S
End If
Set Products = Sheets("Order Entry").Range("A3:A99")
For Each P In Products
If P.Value <> "" Then
Counter = Counter + 1
End If
Next P
Sheets("Order Entry").Rows("3:" & Counter + 11).Hidden = False
Sheets("Order Entry").Rows(Counter + 11 & ":99").Hidden = True
End If
End Sub
Unfortunately I'm not sure which line is erroring as no error message is given.
Thank you for your time.

How do I compare two listboxes?

I have two listboxes (1: Primary, 2:Secondary).
These listboxes contain numbers. The Primary Listbox contains 7 numbers, and the Secondary Listbox contains 6 numbers.
I want to compare the values of the Primary Listbox to those of the Secondary.
This comparison should yield three results:
Result #1:
X number of values were found to be common.
Result#2:
All numbers matched.
Result#3:
No matches found.
This is what I have so far:
If lstPrimaryNumbers.Items.Count = 0 Or lstSecondaryNumbers.Items.Count = 0 Then
MessageBox.Show("There is nothing to compare.", "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End If
For i As Integer = 0 To lstPrimaryNumbers.Items.Contains
For j As Integer = 0 To lstSecondaryNumbers.Items.Contains
If i = j Then
MessageBox.Show(i & " " & j & " matched!")
End If
Next
Next
PLEASE NOTE:
I HAVE CHANGED MY ENTIRE INTERFACE, SO THIS POST IS OBSOLETE AND I HAVE NO USE FOR IT NOW. THANK YOU EVERYONE FOR YOUR SUPPORT!
I will leave this for the moderators to decide whether to remove this post or keep it for other users reference.
I will flag this post.
The matching items could be found with
Dim r = lb1.Items.Cast(Of Int32).Where(Function (x) lb2.Items.Contains(x))
MessageBox.Show(String.Join(",", r) & " matched")
If you want to have a full match, then use IEnumerable.All to check
Dim a = lb1.Items.Cast(Of Int32).All(Function (x) lb2.Items.Contains(x))
If a Then
MessageBox.Show("Full Match")
End If
Finally if you want only know if some items match then use IEnumerable.Any
Dim b = lb1.Items.Cast(Of Int32).Any(Function(x) lb2.Items.Contains(x))
If Not b Then
MessageBox.Show("No matches where found")
End If
I have assumed that your items are integers, but if you add them as strings then you need to change the Cast(Of Int32) to Cast(Of String)
First, I got the contents of the ListBoxes into arrays with a little linq. Then using the .Intersect method found the matches. And displayed the .Count. You iterate the result with a For Each
Private Sub OPCode()
Dim id1() As Integer = (From i In ListBox1.Items Select CInt(i)).ToArray
Dim id2() As Integer = (From i In ListBox2.Items Select CInt(i)).ToArray
Dim Matches As IEnumerable(Of Integer) = id1.Intersect(id2)
MessageBox.Show(Matches.Count.ToString)
End Sub
'TextBox1.Multiline = True is set at design time
'Expand the text box size so several lines will be visible
For Each Match As Integer In Matches
TextBox1.Text &= (CStr(Match) & Environment.NewLine)
Next

Type mismatch error using custom class subroutine in Excel VBA

Working in Excel VBA, I have a class module where I define my class 'Marker'. One of the properties of my class is TextLine(), which is an array that holds up to 5 strings. I have defined the two methods below in my class module. In another (regular) module, I fill markerArr() with my custom Marker objects. Loading each object's properties with data at each array index is working fine... However, after loading data into the object at each index, I try to use markerArr(count).ProcessLines but receive a type mismatch error. Since ProcessLines is a public sub in my class module, and markerArr(count) contains a Marker object, I can't seem to understand why this error is occurring... Am I overlooking something obvious?
'Serial number replacement processing function
Public Sub ProcessLines()
Dim strSerial As String
Dim toggle As Boolean
toggle = False
Dim i As Integer
For i = 0 To 4
If Trim(m_TxtLines(i)) <> "" Then
'Add linefeed char to non-empty text lines
m_TxtLines(i) = m_TxtLines(i) & Chr(10)
'Detect if it is a serialized line
If InStr(1, m_TxtLines(i), "XXXXXX-YYY") > 0 Then
m_Serial(i) = True
toggle = True
End If
End If
Next
'When at least one line on the marker is serialized, create and replace serial text
If toggle = True Then
'Only prompt for input once
If startSerNo < 1 And Num_Sers < 1 Then
startSerNo = InputBox("Enter the serial number to start printing at." & Chr(10) & _
"Entering 1 will result in -001, entering 12 will result in -012, etc.", "Starting Serial #", "1")
Num_Sers = InputBox("Enter the amount of serializations to perform." & Chr(10) & _
"This will control how many copies of the entire marker set are printed.", "Total Serializations", "1")
End If
strSerial = CreateSerial(startSerNo)
Dim j As Integer
For j = 0 To 4
If m_Serial(j) Then
m_TxtLines(j) = Replace(m_TxtLines(j), "XXXXXX-YYY", strSerial)
End If
Next
End If
End Sub
'Creates the string to replace XXXXXX-YYY by concatenating the SFC# with the starting serial number
Private Function CreateSerial(ByVal startNum As Integer)
Dim temp
temp = SFC_Num
Select Case Len(CStr(startNum))
Case 1
temp = temp & "-00" & startNum
Case 2
temp = temp & "-0" & startNum
Case 3
temp = temp & "-" & startNum
Case Else
temp = temp & "-001"
End Select
CreateSerial = temp
End Function
Your CreateSerial function takes an integer as a parameter, but you are attempting to pass a string. I've pointed out some problems:
If startSerNo < 1 And Num_Sers < 1 Then 'Here I assume, you have these semi-globals as a variant - you are using numeric comparison here
startSerNo = InputBox("Enter the serial number to start printing at." & Chr(10) & _
"Entering 1 will result in -001, entering 12 will result in -012, etc.", "Starting Serial #", "1") 'Here startSerNo is returned as a string from the inputbox
Num_Sers = InputBox("Enter the amount of serializations to perform." & Chr(10) & _
"This will control how many copies of the entire marker set are printed.", "Total Serializations", "1") 'here Num_Sers becomes a String too
End If
strSerial = CreateSerial(startSerNo) 'here you are passing a String to the CreateSerial function. Either pass an integer, or allow a variant as parameter to CreateSerial
'......more code.....
Private Function CreateSerial(ByVal startNum As Integer)

Using VLOOKUP to search different sheets

I am trying to search if a number exists in one of the 32 sheets I have in my workbook.
I have tried to use the below mentioned code but it's not working because VLOOKUP is not deciphering the variable(n). Kindly help:
Private Sub SearchAll_Click()
Dim SearchCriteria As Double, s As Integer
SearchCriteria = Me.SearchBox.Value
s = 0
For s = 0 To ThisWorkbook.Sheets.Count
s = s + 1
If Application.WorksheetFunction.VLookup(SearchCriteria, Sheets(s).Range("A:A").Value, 1, False) = SearchCriteria Then
MsgBox ("The Number " & SearchCriteria & " is available in list " & Sheets(s).Name)
Exit For
Else
MsgBox ("The Number is Unavailable")
End If
Next s
End Sub
Legend:
SearchAll is a button used to initiate the search.
SearchCriteria is a textbox used to input the value you want to search for.
There are a few problems in the way you use Application.WorksheetFunction.VLookup to determine if a specific value exists in your workbook. I have modified your code to the following:
Private Sub SearchAll_Click()
Dim SearchCriteria As Double, s As Integer
Dim Lookup As Variant
Dim Match As Boolean
SearchCriteria = Me.SearchBox.Value
For s = 1 To ThisWorkbook.Sheets.Count
Lookup = Application.VLookup(SearchCriteria, Sheets(s).Range("A:A"), 1, False)
If Not IsError(Lookup) Then
MsgBox ("The Number " & SearchCriteria & " is available in list " & Sheets(s).Name)
Match = True
Exit For
End If
Next s
If Match = False Then MsgBox ("The Number is Unavailable")
End Sub
Here I have, instead, made use of Application.VLookup which will return an error to the variant variable Lookup if the search value were not found in the specific sheet. Then, by looking at the error state of Lookup it can be determined if the search value were found. Also, I have moved the message The Number is Unavailable outside the loop in order to avoid it being triggered each time the value were not found in a specific sheet.