Private Sub Command4_Click()
Dim x As Integer
r = InputBox("Enter row size ")
c = InputBox("Enter column size ")
ReDim arr(r, c) As Integer
For i = 0 To r - 1 Step 1
For j = 0 To c - 1 Step 1
arr(i, j) = InputBox("Enter row : " & (i + 1) & "column size : " & (j + 1))
Next j
Next i
For i = 0 To r - 1
For j = 0 To c - 1
Text1.Text = Text1.Text & " " & arr(i, j)
Next j
Text1.Text = Text1.Text & vbNewLine & vbCr
Next i
End Sub
This is my code for taking inputs in an array. Here everything is working fine except this line "Text1.Text = Text1.Text & vbNewLine & vbCr" here I am trying to print the array in row-column in 2D form inside a text box but its not happening "vbNewLine or vbcr" both are not working and my array is getting printed in a single line.
I suggest vbCrLf instead of vbNewLine & vbCr, and you need to make sure you have your textbox set to Multiline in the properties editor.
Related
This code is a part of bigger code that takes words from a listbox and places into another listbox, which with this code separates the words in the listbox and establishes into words that are able to be inserted into a cell, for some reason second strsplt is not showing, everything else is working very well, it's just this one, I need help with and there is no error that is thrown out. I've looked it over with F8 and breakpoints and the problem seems to be with
If ii < .ColumnCount - 1 Then
str = str & .List(i, ii) & vbCrLf
Else
str = str & .List(i, ii)
End If
The Whole Code:
With Me.selecteditems
ThisWorkbook.Sheets(9).Range("A:B").ClearContents
For i = 0 To .ListCount - 1
If .Selected(i) Then
found = True
For ii = 0 To .ColumnCount - 1
ReDim strsplt(0 To i)
If str = "" Then
str = .List(i, ii) & vbCrLf
Else
If ii < .ColumnCount - 1 Then
str = str & .List(i, ii) & vbCrLf
Else
str = str & .List(i, ii)
End If
End If
Next ii
message = "How much" & vbCrLf & str & "?" & vbCrLf
title = "Amount"
defaultval = "1"
quantity = InputBox(message, title, defaultval)
strsplt = Split(str, "*")
End If
'On Error Resume Next
With ThisWorkbook.Sheets(9)
.Range("A" & (i + 1)).Value = strsplt(i)
.Range("B" & (i + 1)).Value = quantity
End With
'On Error GoTo 0
Next i
End With
EDIT: The way it looks like using debug.print str
item1
item2 item3 item4 ...
Try a bit brute forcing like this:
If ii < .ColumnCount - 1 Then
str = str & .List(i+1, ii) & vbCrLf
Else
str = str & .List(i+1, ii)
End If
I have changed i to i+1 in your code.
Then debug again. If it does not work, try i-1, ii+1, ii-1. One of these will work and it may give an out of range error. Then fix the array length and have fun.
I have used this loop to display Data that graph using the Google Chart
The problem is that the graph contains a lot of data and it takes a long time to be made loaning
The question is whether there is a faster way to pass the data base?
dRow As Data.DataRow In xdata.Rows
If j = 0 Then
TempDate = Format(CDate(dRow.Item(0)), "dd/MM/yyyy")
MyXML += "[new Date(" & TempDate.Year & "," & TempDate.Month - 1 & ")"
j += 1
Else
TempDate = Format(CDate(dRow.Item(0)), "dd/MM/yyyy")
MyXML += ",[new Date(" & TempDate.Year & "," & TempDate.Month - 1 & ")"
j += 1
End If
For colIdx As Byte = 1 To xdata.Columns.Count - 1
If colIdx > 0 Then
If (dRow.Item(colIdx)).ToString <> Nothing Then
MyXML += "," & (dRow.Item(colIdx)).ToString
Else
MyXML += "," & "0"
End If
End If
`
You should be using a StringBuilder if you are going to be concatenating hundreds of strings. .NET strings are immutable which means each time they change, a new object has to be created.
Dim sb As New StringBuilder
For dRow As Data.DataRow In xdata.Rows
If j = 0 Then
TempDate = Format(CDate(dRow.Item(0)), "dd/MM/yyyy")
sb.Append("[new Date(" & TempDate.Year & "," & TempDate.Month - 1 & ")")
j += 1
Else
TempDate = Format(CDate(dRow.Item(0)), "dd/MM/yyyy")
sb.Append(",[new Date(" & TempDate.Year & "," & TempDate.Month - 1 & ")")
j += 1
End If
For colIdx As Byte = 1 To xdata.Columns.Count - 1
If colIdx > 0 Then
If (dRow.Item(colIdx)).ToString <> Nothing Then
sb.Append("," & (dRow.Item(colIdx)).ToString)
Else
sb.Append("," & "0")
End If
End If
Next
Next
And when you're done parsing the data:
Return sb.ToString
I want to display a textlog string in a userform's textbox.
Code might look like this:
Dim public textlog as string
sub button1_click()
' do some action
textlog = textlog & event_string & vbCrLf
'event_string might exceed more than 2 line
textlog = textlog & "button1 action" & vbCrLf
userform1.textbox1.text = textlog
end sub
sub button2_click()
' do some action
textlog = textlog & event_string & vbCrLf
'event_string might exceed more than 2 line
textlog = textlog & "button2 action" & vbCrLf
userform1.textbox1.text = textlog
end sub
However, the textbox should only contain 20 lines of information, while my
the contents of my textlog will exceed 20 lines.
How can I display only the latest (last) 20 lines of the textlog in textbox1?
You can use this function to return only the last N lines of a string, and then display that in your textbox.
Note that you have to specify what the line break character is. Depending on your specific application, it could be vbCrLf, vbCr, vbLf, or even some other delimiter.
Function GetLastLines(ByVal s As String, ByVal nLinesToDisplay As Long, _
Optional ByVal lineBreakChar As String = vbCrLf)
'Split the string into an array
Dim splitString() As String
splitString = Split(s, lineBreakChar)
'How many lines are there?
Dim nLines As Long
nLines = UBound(splitString) + 1
If nLines <= nLinesToDisplay Then
'No need to remove anything. Get out.
GetLastLines = s
Exit Function
End If
'Collect last N lines in a new array
Dim lastLines() As String
ReDim lastLines(0 To nLinesToDisplay - 1)
Dim i As Long
For i = 0 To UBound(lastLines)
lastLines(i) = splitString(i + nLines - nLinesToDisplay)
Next i
'Join the lines array into a single string
GetLastLines = Join(lastLines, lineBreakChar)
End Function
Example usage:
MsgBox GetLastLines( _
"line 1" & vbCrLf & "line 2" & vbCrLf & "line 3" & vbCrLf _
& "line 4" & vbCrLf & "line 5" & vbCrLf & "line 6", _
4, vbCrLf)
Only the last 4 lines are displayed:
Note that this assumes that your last line is not terminated by a line break. If it is, then you can tweak the code to deal with that.
Alternatively, you can use Excel's built-in SUBSTITUTE function, which is useful in this particular case, because it can locate a specific instance of a given character. So instead of building arrays you can use a one-liner:
Function GetLastLines2(ByVal s As String, ByVal nLinesToDisplay As Long, _
Optional ByVal lineBreakChar As String = vbCrLf)
'An arbitrary character that will never be in your input string:
Dim delim As String: delim = Chr(1)
'How many lines are there?
Dim nLines As Long
nLines = UBound(Split(s, lineBreakChar)) + 1
If nLines <= nLinesToDisplay Then
'No need to remove anything. Get out.
GetLastLines2 = s
Exit Function
End If
'Replace one line break with delim, split the string on it,
'return only second part:
GetLastLines2 = Split( _
WorksheetFunction.Substitute( _
s, lineBreakChar, delim, nLines - nLinesToDisplay), _
delim)(1)
End Function
A = "Cat" & vbcrlf & "Tiger" & vbcrlf & "Lion" & vbcrlf & "Shark hunting florida lynxs" & vbcrlf & "Leopard" & vbcrlf & "Cheetah"
A= StrReverse(A)
NumLines = 3
i=1
For X = 1 to NumLines
i = Instr(i, A, vbcr) + 1
Next
Msgbox StrReverse(Left(A, i - 1))
This is a program that cuts or leaves lines from top or bottom of files.
To use
Cut
filter cut {t|b} {i|x} NumOfLines
Cuts the number of lines from the top or bottom of file.
t - top of the file
b - bottom of the file
i - include n lines
x - exclude n lines
Example
cscript //nologo filter.vbs cut t i 5 < "%systemroot%\win.ini"
The script
Set rs = CreateObject("ADODB.Recordset")
With rs
.Fields.Append "LineNumber", 4
.Fields.Append "Txt", 201, 5000
.Open
LineCount = 0
Do Until Inp.AtEndOfStream
LineCount = LineCount + 1
.AddNew
.Fields("LineNumber").value = LineCount
.Fields("Txt").value = Inp.readline
.UpDate
Loop
.Sort = "LineNumber ASC"
If LCase(Arg(1)) = "t" then
If LCase(Arg(2)) = "i" then
.filter = "LineNumber < " & LCase(Arg(3)) + 1
ElseIf LCase(Arg(2)) = "x" then
.filter = "LineNumber > " & LCase(Arg(3))
End If
ElseIf LCase(Arg(1)) = "b" then
If LCase(Arg(2)) = "i" then
.filter = "LineNumber > " & LineCount - LCase(Arg(3))
ElseIf LCase(Arg(2)) = "x" then
.filter = "LineNumber < " & LineCount - LCase(Arg(3)) + 1
End If
End If
Do While not .EOF
Outp.writeline .Fields("Txt").Value
.MoveNext
Loop
End With
lblTable.Text = ""
For i = 1 To 4
For j = 1 To 4
lblTable.Text = i & "×" & j & "=" & i * j
Next j
Next i
As the code shows above, I tried to make multiplication table from 1 to 4, but when I ran the program, the table would all show in one row, not like the sample. Is there anything miss in my code?
Not really sure how you're getting that "table" to display in the form (you must have omitted the code, because the code you provide simply replaces lblTable.Text in the inner loop each time. In any case, you can write each out to an array, and the drop the array to the worksheet like so:
Dim arr(1 to 4, 1 to 4) as String
lblTable.Text = ""
For i = 1 To 4
For j = 1 To 4
lblTable.Text = i & "×" & j & "=" & i * j
arr(i,j) = lblTable.Text
Next j
Next i
Range("A1").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
Format your label with a non-proportional font so everything lines up.
Dim s as string, i, j
s = ""
For i = 1 To 4
For j = 1 To 4
s = s & Left(i & "×" & j & "=" & (i * j) & " ", 9)
if j = 4 Then s = s & chr(10)
Next j
Next i
lblTable.Text = s
dasaset (ds) contain value like this comapring two dataset and write the phone number from dataset to notepad which is not equal to dataset1.but am getting the result in notepad like the phone numbers which are equal to both dataset
dataset
-------
91 9942321400
91 9865015695
91 9677031515
91 9994828285
91 9688104229
dataset1 values
----------------
91 9942321400
91 9865015695
91 9677031515
expected result in notepad
--------------------------
91 9994828285
91 9688104229
my code
-------
Dim i As Integer = 0
Dim toggle As Boolean = False
Do While (i <= ds1.Tables(0).Rows.Count - 1)
Dim phone As String = ds1.Tables(0).Rows(i).Item(1).ToString
Dim j As Integer = 0
Do While (j <= Ds.Tables(0).Rows.Count - 1)
Dim dumphone As String = Ds.Tables(0).Rows(j).Item(4).ToString
If dumphone <> phone Then toggle = True 'This will set your flag to add the output.
j = (j + 1)
Loop
'After we're done checking if there's a match, we decided to add it to the output.
If toggle = True Then
TextBox1.AppendText(a.ToString & "|" & b.ToString & "|" & c.ToString & "|" & d.ToString & "|" & phone.ToString & "|" & e1.ToString & "|" & f.ToString & "|" & g.ToString & "|" & h.ToString & "|" & i1.ToString & "|" & j1.ToString & "|" & k.ToString & "|" & l.ToString & "|" & m.ToString & "|" & n1.ToString & "|" & o.ToString & "|" & p.ToString & "|" & q.ToString & "|" & r.ToString & "|" & s.ToString & "|" & t.ToString & "|" & u.ToString & "|" & v.ToString & "|" & w.ToString & "|" & x.ToString)
sw.WriteLine(TextBox1.Text)
TextBox1.Text = ""
toggle = False 'Reset the flag for the next value
End If
i = (i + 1) 'Move to the next value to check against.
Loop
but am getting the output in note pad like this
------------------------------------------------
91 9942321400
91 9865015695
91 9677031515
I tried this way and I got the result you were looking for...
For i As Integer = 0 To dataset.Tables(0).Rows.Count - 1
Dim found As Boolean = False
For j As Integer = 0 To dataset1.Tables(0).Rows.Count - 1
If dataset.Tables(0).Rows(i)(0).ToString = dataset1.Tables(0).Rows(j) (0).ToString Then
found = True
End If
Next
If found = False Then
'here you are getting the right result in each loop
'in this example i'm showing the result in a textbox
'just change the instruction and write them in your note pad or wherever you want to
MsgBox(dataset.Tables(0).Rows(i)(0).ToString)
End If
Next