I am new to vb6, I need it for my school, I have tried so much, I cant do it
this is my practice
a program that has passengers(Name,FlightNumber,Departure,arrival)
when you type "R" every passenger specification should go to the computer
when you type I every Passenger specification should show
when you type E the program should finish
I have Used 2dArray which is called Passengers(3,4) because I have four columns
and nested for and an input box for entering information, but I don't know how to show columns labels, therefor user understands which column to type?
and I don't know is it right to use arrays, and list for showing information?
would you please help me with code? I am using vb6
this is my code,is there better any better way?
Dim a(5, 4)
Dim i, j As Integer
If Text1.Text = "R" Then
For i = 1 To 5
a(i, 1) = Val(InputBox("Please enter Passenger Name:"))
a(i, 2) = Val(InputBox("Please enter Passenger Flight Number:"))
a(i, 3) = Val(InputBox("Please enter Passenger Departure:"))
a(i, 4) = Val(InputBox("Please enter Passenger Arrival:"))
Next i
ElseIf Text1.Text = "I" Then
Picture1.Cls
Picture1.Print "Passenger"; Space(3); "Value of element"
For j = 1 To 4
Picture1.Print "Passenger"; 1; Space(11); a(1, j); "Passenger"; 2; Space(11);
a(2, j); 'and other coulmns
Next j
ElseIf Text1.Text = "E" Then
End
End If
End Sub
Its better if you reformat your code
Dim a(5, 4)
Dim i, j As Integer
If Text1.Text = "R" Then
For i = 1 To 5
a(i, 1) = Val(InputBox("Please enter Passenger Name:"))
a(i, 2) = Val(InputBox("Please enter Passenger Flight Number:"))
a(i, 3) = Val(InputBox("Please enter Passenger Departure:"))
a(i, 4) = Val(InputBox("Please enter Passenger Arrival:"))
Next i
ElseIf Text1.Text = "I" Then
Picture1.Cls
Picture1.Print "Passenger"; Space(3); "Value of element"
For j = 1 To 4
Picture1.Print "Passenger"; 1; Space(11); a(1, j); "Passenger"; 2; Space(11);
a(2, j); 'and other coulmns
Next j
ElseIf Text1.Text = "E" Then
End
End If
Related
I'm trying to make a random number game but the condition is always false even though I added the b = input box statement
Option Explicit
dim b,a,max,min
'To randomize variable (a)
max=3
min=1
Randomize
a = (Int((max-min+1)*Rnd+min))
b = inputbox("Guess a number from " & min & " to " & max)
If a = b Then
msgbox("you win")
Else
msgbox("you died it was " & a)
End If
I expected when you guessed the right number it would say you when but it always you died the number was #
You are almost there but as has been mentioned in the comments you do not populate the variable be with a values so the comparison will always be False.
If you are expecting b to be populated by the user you could ask for input via the InputBox() function by adding one line;
Option Explicit
Dim beans, b, a, max, min
'To randomize variable (a)
max = 100
min = 1
Call Randomize()
'Enter the line below to collect input from the user.
b = InputBox("Enter a number between " & min & " and " & max & ".")
'Remember to round the number to make sure you have a whole number.
a = Round((Int((max - min + 1) * Rnd() + min)))
If (a = b) Then
Call MsgBox("You win")
Else
Call MsgBox("You died it was " & a)
End If
You might also consider validating the input to make sure that the user enters a value between your min and max and responding accordingly if the value is invalid.
This matches 1 - 10.
Randomize
Num = Int((10 - 1 + 1) * Rnd + 1)
If CInt(Inputbox("Enter Number")) = Num Then
Msgbox "match"
Else
Msgbox "Nope it was " & Num
End If
The formula from help is Int((upperbound - lowerbound + 1) * Rnd + lowerbound). See http://download.microsoft.com/download/winscript56/Install/5.6/W982KMeXP/EN-US/scrdoc56en.exe.
I am trying to simulate the I/O of this website page
My Input sheet looks like this:
Now after taking the values from input sheet and arranging them in ascending order I got this in a temp worksheet :
This is what my results sheet looks like:
Now I have tried this after sorting process(didn't add code for sorting since it's not the problem):
Set rng = Union(wTime.Range("D6:D25"), wTime.Range("F6:F25"), wTime.Range("H6:H25"), wTime.Range("J6:J25"))
cnt1 = 1: cnt2 = 1: cnt3 = 1: cnt4 = 1
wTime.Range("A6:A25") = Empty 'Ticker
For i = 1 To 20
bckStroke(i) = wTemp.Range("A" & i + 1).Value
brstStroke(i) = wTemp.Range("C" & i + 1).Value
btrFly(i) = wTemp.Range("E" & i + 1).Value
frStyle(i) = wTemp.Range("G" & i + 1).Value
wTime.Range("A6:A25") = Empty
For Each cel In rng
If cel.Column = 4 And cel.Value = bckStroke(i) And cel.Value <> 0 And Trim(wTime.Cells(cel.Row, 1)) <> "Y" And cnt1 < 6 Then
wRes.Cells((cnt1 + 5 + (cnt1 - 1) * 2) - 1, 4) = wTime.Cells(cel.Row, 2) 'Athlete Name
wRes.Cells(cnt1 + 5 + (cnt1 - 1) * 2, 4) = bckStroke(i) 'Time
cnt1 = cnt1 + 1
wTime.Cells(cel.Row, 1) = "Y"
End If
If cel.Column = 6 And cel.Value = brstStroke(i) And cel.Value <> 0 And Trim(wTime.Cells(cel.Row, 1)) <> "Y" And cnt2 < 6 Then
wRes.Cells((cnt2 + 5 + (cnt2 - 1) * 2) - 1, 6) = wTime.Cells(cel.Row, 2) 'Athlete Name
wRes.Cells(cnt2 + 5 + (cnt2 - 1) * 2, 6) = brstStroke(i) 'Time
cnt2 = cnt2 + 1
wTime.Cells(cel.Row, 1) = "Y"
End If
If cel.Column = 8 And cel.Value = btrFly(i) And cel.Value <> 0 And Trim(wTime.Cells(cel.Row, 1)) <> "Y" And cnt3 < 6 Then
wRes.Cells((cnt3 + 5 + (cnt3 - 1) * 2) - 1, 8) = wTime.Cells(cel.Row, 2) 'Athlete Name
wRes.Cells(cnt3 + 5 + (cnt3 - 1) * 2, 8) = btrFly(i) 'Time
cnt3 = cnt3 + 1
wTime.Cells(cel.Row, 1) = "Y"
End If
If cel.Column = 10 And cel.Value = frStyle(i) And cel.Value <> 0 And Trim(wTime.Cells(cel.Row, 1)) <> "Y" And cnt4 < 6 Then
wRes.Cells((cnt4 + 5 + (cnt4 - 1) * 2) - 1, 10) = wTime.Cells(cel.Row, 2) 'Athlete Name
wRes.Cells(cnt4 + 5 + (cnt4 - 1) * 2, 10) = frStyle(i) 'Time
cnt4 = cnt4 + 1
wTime.Cells(cel.Row, 1) = "Y"
End If
Next cel
Next i
I just want to know the simplest logic to get the desired result after arranging them in ascending order (refer temp sheet) it should be easy but I can't seem to understand it.
Conditions that I know of for now:
Each team should have unique swimmers (i.e 4 Unique names in each team)
A swimmer can appear in other team as well if he has best time in other category as well. (E.g. Marcelo will appear in top 4 team since he has the best time in all 4 categories)
Teams with shortest time should be placed 1st in the list on result sheet. I think sorting in ascending order takes care of this it's matter of selecting right swimmer from the temp sheet list.
EDIT:
4. Relay Logic premise: Get all the combinations possible without 2 identical strings. And then sort them lowest to largest. I'd do the following: Get all the possible combinations and their sum with the following: *Combinations may still be buggy, since it may be variable to how many numbers you may have. This is just a guide to describe the process
Sub Combinations()
Dim i As Long, j As Long, k As Long, l As Long, m As Long, n As Long, o As Long, p As Long, q As Long
Dim CountComb As Long, lastrow As Long
Range("K2").Value = Now - 5
Application.ScreenUpdating = False
CountComb = 0: lastrow = 6
For i = 1 To 6: For j = 1 To 5
For k = 1 To 6: For l = 1 To 6
If Not (i = j Or i = k Or i = l Or j = k Or j = l Or k = l) Then
Range("K" & lastrow).Value = Range("A" & i).Value & "/" & _
Range("B" & j).Value & "/" & _
Range("C" & k).Value & "/" & _
Range("D" & l).Value
lastrow = lastrow + 1
CountComb = CountComb + 1
End If
Next: Next
Next: Next
Range("K1").Value = CountComb
Range("K3").Value = Now + 21
Application.ScreenUpdating = True
End Sub
Function TimeSum(Persons As String, Chr As String) As Double
Dim ArrayPersons() As String: ArrayPersons = Split(Persons, Chr)
Dim SumOfTime As Double
Dim ItemPerson As Variant
Dim NumberRoutines As Long: NumberRoutines = 2
Const SheetData = "Sheet1"
For Each ItemPerson In ArrayPersons
SumOfTime = Sheets(SheetData).Columns(NumberRoutines).Find(ItemPerson).Offset(0, -1).Value + SumOfTime
NumberRoutines = NumberRoutines + 2
Next ItemPerson
TimeSum = SumOfTime
End Function
Maybe you could define better the sub to do what you desire for, but, the last coding could guide you in the right path. In a second thought, you could get combinations in a dictionary instead.
[
[
Recently I am trying to get the permutation of undetermined number of variables. For undetermined I mean I was aiming to create an input box for users to put in the number.
Start from simple. Originally I was aiming to get a 4 digits permutations with each digit have different number of variables, i.e. 1st digit can only be A,B,C,D; 2nd digit be E,F; 3rd digit be G, H etc. Code are below:
Sub Permut()
Count = 1
For a = 1 To 4
For b = 1 To 2
For c = 1 To 2
For d = 1 To 2
For e = 1 To 2
'chr(97) is the alphabet "a"
Cells(Count, 1) = Chr(96 + a) & Chr(96 + Len(a) + b) & Chr(96 + Len(a) + Len(b) + c) & _
Chr(96 + Len(a) + Len(b) + Len(c) + d) & Chr(96 + Len(a) + Len(b) + Len(c) + Len(d) + e)
Count = Count + 1
Next
Next
Next
Next
Next
End Sub
This will give you 64 different combinations without repetition.
Just wondering is there a way to generalize this process so that people can choose how many variables in total as well as within each digit?
Thank you.
Here is a solution, where you would pass the Permut function the minimum value for each of the characters (digits) as one string, and the maximum characters also as a string. Both strings should have an equal number of characters of course:
Function Permut(min, max)
Dim str, nxt, count
str = min
count = 1
Do While str < max
Cells(count, 1) = str
count = count + 1
nxt = ""
For i = Len(str) To 1 Step -1
If Mid(str, i, 1) < Mid(max, i, 1) Then
nxt = ChrW(AscW(Mid(str, i, 1))+1) & nxt
Exit For
End If
nxt = Mid(min, i, 1) & nxt
Next
str = Left(str, Len(str) - Len(nxt)) & nxt
Loop
Cells(count, 1) = str
End Sub
You would call it like this:
Permut "abc", "bcf"
That example would produce this list on your sheet:
abc
abd
abe
abf
acc
acd
ace
acf
bbc
bbd
bbe
bbf
bcc
bcd
bce
bcf
How to Execute This with User Input and Button Click
If you want to call this code in response to an event, such as a button click, and want to pass it the contents of two cells where the user would first enter the min and max strings, then follow these steps:
Place an ActiveX command button on your sheet (put it somewhere in D1 to leave room for some other stuff)
Double click it to generate the empty click event handler. If that does not work, go to the code window and select the name of the button from the drop-down at the top of the window, and select Click from the next drop down.
Complete the code of that event handler as follows (I assume the button is called CommandButton1, but don't change the generated name):
Code:
Private Sub CommandButton1_Click()
Permut Range("B1"), Range("C1")
End Sub
This code assumes the user has to enter the min and max digits/characters in cells B1 and C1. The A column is of course reserved for the output of the code.
For a more complete explanation on how to add a command button and attach code to its click event, read "Add a command button (ActiveX control)" in the Office manual.
credit to the answer from trincot above.
I have tried to run the code with a bit modification coz I am not sure how to get set value into cells (0,1). It keeps saying error. But If I change the starting point to Cells(1,1) then I will miss the last permutation. So I just add an additional if statement to get the code work as I want.
Function Permut(min, max)
Dim str, nxt, count
str = min
count = 1
Do While str < max
Cells(count, 1) = str
count = count + 1
nxt = ""
For i = Len(str) To 1 Step -1
If Mid(str, i, 1) < Mid(max, i, 1) Then
'asc("a")=97; chr(97) ="a"
nxt = Chr(AscW(Mid(str, i, 1)) + 1) & nxt
Exit For
End If
nxt = Mid(min, i, 1) & nxt
Next
str = Left(str, Len(str) - Len(nxt)) & nxt
If str = max Then
Cells(count, 1) = str
End If
Loop
End Function
I am running osx 10.9 and Excel:Mac2011. I have need to count how many of each item I have in an Excel spreadsheet.
For example:
Cat
Fish
Cat
Dog
Cat
Dog
I'm trying to get some output that would look like this
Cat Cat =3
Fish Dog =2
Cat Fish =1
Dog
Cat
Dog
the output does not need to be sorted/ordered. First come first counted/listed is fine, but i can sort the data if it needs to be.(or makes it easier)
If there is any more information I can provide to help you help me please let me know.
First and simplest, if you know that there aren't many different values in the column, you could just use countif():
=COUNTIF(A1:A6, "Cat")
Otherwise, if you've got tons of different items in a column and you want an automated solution, a VBA routine that scans the column, tallies the counts of each item, and deposits those counts in other columns seems reasonable.
Sub CountAll()
Dim searchCol, itemsCol, countCol, sheetName As String
Dim i, j, startRow As Integer
Dim aCounts() As Variant
Dim bAdded, bFound As Boolean
startRow = 1
searchCol = "A"
itemsCol = "B"
countCol = "C"
sheetName = "Sheet1"
ReDim aCounts(2, 1)
With Sheets(sheetName)
For i = 1 To .Range(searchCol & startRow).End(xlDown).Row
For j = 1 To UBound(aCounts, 2)
If (.Range(searchCol & i).Value) = aCounts(0, j) Then
bFound = True
Exit For
Else
bFound = False
End If
Next
If (bFound) Then
aCounts(1, j) = aCounts(1, j) + 1
Else
If (aCounts(1, UBound(aCounts, 2)) <> "") Then
ReDim Preserve aCounts(2, UBound(aCounts, 2) + 1)
End If
aCounts(0, UBound(aCounts, 2)) = .Range(searchCol & i).Value
aCounts(1, UBound(aCounts, 2)) = 1
End If
Next
i = 1
For i = 1 To UBound(aCounts, 2)
.Range(itemsCol & i).Value = aCounts(0, i)
.Range(countCol & i).Value = aCounts(1, i)
Next
End With
End Sub
If all your sheets are similar and you want it to run on each sheet, just change the With Sheets(sheetName) to For Each Sheet in Sheets, change End With to Next, add Sheet before each .Range, and reset the array with each iteration:
For Each Sheet In Sheets()
ReDim aCounts(2, 1)
For i = 1 To Sheet.Range(searchCol & startRow).End(xlDown).Row
For j = 1 To UBound(aCounts, 2)
If (Sheet.Range(searchCol & i).Value) = aCounts(0, j) Then
bFound = True
Exit For
Else
bFound = False
End If
Next
If (bFound) Then
aCounts(1, j) = aCounts(1, j) + 1
Else
If (aCounts(1, UBound(aCounts, 2)) <> "") Then
ReDim Preserve aCounts(2, UBound(aCounts, 2) + 1)
End If
aCounts(0, UBound(aCounts, 2)) = Sheet.Range(searchCol & i).Value
aCounts(1, UBound(aCounts, 2)) = 1
End If
Next
For i = 1 To UBound(aCounts, 2)
Sheet.Range(itemsCol & i).Value = aCounts(0, i)
Sheet.Range(countCol & i).Value = aCounts(1, i)
Next
Next
You could loop through all the sheets creating a pivot table for each one, and then copy and paste the data from each pivot table, back onto the source sheet. It's a weird way of doing it, but it will work. Here is the code:
Option Explicit
Sub PivotTableCreator()
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'Done so excel will delete the pivot table sheet without displaying a messagebox asking you if you are sure
Dim i, WSCount, LastRow As Long
WSCount = ActiveWorkbook.Worksheets.Count
Dim PTCache As PivotCache
Dim PT As PivotTable
For i = 1 To WSCount
Worksheets(i).Activate
LastRow = Range("A1000000").End(xlUp).Row
Debug.Print LastRow
Set PTCache = ActiveWorkbook.PivotCaches.Create(xlDatabase, Range("A1", "A" & LastRow)) 'data from column A is used to create the pivot table
Worksheets.Add 'new worksheet created for pivottable
Set PT = ActiveSheet.PivotTables.Add(PivotCache:=PTCache, TableDestination:=Range("A1"))
With PT
.PivotFields("Animals").Orientation = xlRowField 'Place whatever column A's header is here (Animals is a placeholder)
.PivotFields("Animals").Orientation = xlDataField
.DisplayFieldCaptions = False
End With
ActiveCell.CurrentRegion.Copy
Worksheets(ActiveSheet.Index + 1).Range("B2").PasteSpecial Paste:=xlPasteValues 'Paste results where you want to, I use B2 in this example
ActiveSheet.Delete 'No longer need the pivot table, so this sheet is deleted
Next
End Sub
This question has been asked before, but I can't find an answer that is easily applicable to Excel VBA.
Basically I want to do exactly what this poster has asked, but in VBA. I want to create an array, n x 2^n, where each line represents a different permutation of n variables which can be either 0 or 1.
I've played around with this for ages, and it's easy enough to do for a set n with loads of loops, but for a variable n I can't find anything that works.
Any code or just suggestions of ways of going about this would be much appreciated!
This will list the value in column A
Sub EasyAsCounting()
Dim N As Long, M As Long, K As Long
N = Application.InputBox(Prompt:="Enter N", Type:=1)
M = 2 ^ N - 1
For K = 0 To M
Cells(K + 1, 1) = "'" & Application.WorksheetFunction.Dec2Bin(K, N)
Next K
End Sub
EDIT#1
This stores the array in VBA only:
Sub EasyAsCounting()
Dim N As Long, M As Long, K As Long, ary, s As String
Dim J As Long
N = Application.InputBox(Prompt:="Enter N", Type:=1)
M = 2 ^ N - 1
ReDim ary(1 To M + 1, 1 To N)
For K = 0 To M
s = Application.WorksheetFunction.Dec2Bin(K, N)
For J = 1 To N
ary(K + 1, J) = Mid(s, J, 1)
Next J
Next K
'
'display the array
'
msg = ""
For K = 1 To M + 1
For J = 1 To N
msg = msg & " " & ary(K, J)
Next J
msg = msg & vbCrLf
Next K
MsgBox msg
End Sub
Here's one if you're not in Excel and don't have access to the functions. Or if you have a number greater than 511.
Sub MakePerms()
Dim i As Long, j As Long
Dim n As Long
Dim aPerms() As Byte
Dim lCnt As Long
Dim sOutput As String
Const lVar As Long = 4
ReDim aPerms(1 To 2 ^ lVar, 1 To lVar)
For i = 0 To UBound(aPerms, 1) - 1
n = i
lCnt = lVar
aPerms(i + 1, lCnt) = CByte(n Mod 2)
n = n \ 2
Do While n > 0
lCnt = lCnt - 1
aPerms(i + 1, lCnt) = CByte(n Mod 2)
n = n \ 2
Loop
Next i
For i = LBound(aPerms, 1) To UBound(aPerms, 1)
sOutput = vbNullString
For j = LBound(aPerms, 2) To UBound(aPerms, 2)
sOutput = sOutput & Space(1) & aPerms(i, j)
Next j
Debug.Print sOutput
Next i
End Sub