Conditional Sum in Another Workbook, by Using VBA Button From a Workbook - window

WE WANT TO SUM THE RANGE FROM ANOTHER WORKBOOK myDividendBook Where the reported field matches to a condition. but, all this calculation to be done through my workbook. Portfolio Management System VBA User form
I tried
Dim lr As Integer
lr = Application.WorksheetFunction.CountA(sWorbook.worksheet("TICKET-CASH").Range("B:B"))
'''' Put the formula
If lr > 1 Then
sWorbook.worksheet("TICKET-CASH").Range("M2").Value = "=SUMIFS(sWorbook.worksheet(TICKET-CASH!I:I),sWorbook.worksheet(TICKET-CASH!L2),sWorbook.worksheet(TICKET-CASH!F:F))"
If lr > 2 Then
sWorbook.worksheet("TICKET-CASH).Range("L2:M" & lr).FillDown
End If
sWorbook.worksheet("TICKET-CASH").Calculate
End If
''''' Sort data
sWorbook.worksheet("TICKET-CASH").UsedRange.Sort key1:=Inv_sh.Range("M1"), order1:=xlAscending, Header:=xlYes
but unfortunately there is error

Related

I am trying to get 6 separate input numbers from the user for my program using one textbox

I have been trying to use a textbox in VB6 to acquire 6 different random numbers chosen by the user to use in part of my program. I have tried many different approaches in different areas of the code. Best I have gotten so far is in the keypress section. I set up an array to store the 6 entries buy fail to be able to get past storing one number in the first element. I'm using a for next loop to cycle through the elements but the textbox.setfocus will not work properly in the loop. I clear the box then setfocus after I assign the number to an element in the array. The only other way I'm thinking this would work is to hide the single box and show 6 hidden ones and then they can tab or I can hide each one again as they fill up.
Here's a snip of that code so one should get an idea what I'm trying to do here.
Private Sub Inbox_Keypress(KeyAscii As Integer)
Select Case KeyAscii ' Determine keypress
Case vbKey0 To vbKey9 'Only the numbers
Case vbKeyBack, vbKeyClear, vbKeyDelete ' Accept these keys
Case vbKeyLeft, vbKeyRight ' Arrow keys
Case 13 ' Enter
If GenOpt(5).Value = True Then
For c = 1 To 6
Gen6_user(c) = Inbox.Text
'Select Case KeyAscii
' Case 13
Talkbox.Caption = "Please enter the next user number for Generator 6"
'Case Else
' MsgBox Msg, style, title
'End Select
If c = 6 Then Exit For
Do
Inbox.Text = ""
Inbox.SetFocus
Loop Until KeyAscii = 13
Next
For c = 1 To 6
Msg6.Print Gen6_user(c)
Next
Else
User_number = Inbox.Text ' Assign any final value to User_number variabl)
Generate.SetFocus
'Generate_Click ' Call generate function
End If
Any help would be appreciated
Journey
I am at work and I don't have VB6 handy here... but, this should work (maybe with a few little tweaks, I am sure you can figure those out):
Dim x As Integer = 1
Dim myArray(6) As Integer
Private Sub TextBox1_KeyUp(KeyCode As Integer)
If KeyCode = 13 Then
myArray(x) = TextBox1.Text
x = x + 1
TextBox1.Text = ""
End If
If x = 6 Then
Debug.Print("Here you check your numbers?")
End If
End Sub

Modifying an Excel VBA Script to Work in Word

I have the following VBA code:
Sub test2()
Dim w1 As Worksheet
Dim w2 As Worksheet
Dim k As Long
Dim c As Range
Dim d As Range
Dim strFA As String
Set w1 = Sheets("Sheet1")
Set w2 = Sheets("Sheet2")
w2.Cells.Clear
k = 1
With w1.Range("A:A")
Set c = .Cells.Find("FirstThing", After:=.Cells(.Cells.Count), lookat:=xlWhole)
strFA = ""
While Not c Is Nothing And strFA <> c.Address
If strFA = "" Then strFA = c.Address
If IsError(Application.Match(c.Offset(0, 1).value, w2.Range("A:A"), False)) Then
Set d = .Cells.Find("SecondThing", c, , xlWhole)
w2.Range("A" & k).value = c.Offset(1, 0).value
w2.Range("B" & k).value = d.Offset(0, 1).value
k = k + 1
End If
Set c = .Cells.Find("FirstThing", After:=c, lookat:=xlWhole)
Wend
End With
End Sub
The code works essentially like this:
Look through Sheet1 for a certain phrase.
Once the phrase is found, place the value from the cell one row over in Sheet2
Search for a second phrase.
Place the value from the cell one row over in the cell beside the other value in Sheet2
Repeat
Now. I have the same data that, don't ask me why, is in .doc files. I'd like to create something similar to this code that will go through and look for the first phrase, and place the next n characters in an Excel sheet, and then look for the second phrase and place the next m characters in the row beside the cell housing the previous n characters.
I'm not sure whether it's better to do this with a bash script or whether it's possible to do this with VBA, so I've attached both as tags.
Your question seems to be: "I'm not sure whether it's better to do this with a bash script or whether it's possible to do this with VBA"
The answer to that is: You'd need VBA, especially since this is a *.doc file - docx would be a different matter.
In order to figure out what that is, start by trying to do the task manually in Word. More specifically, how to use Word's "Find" functionality. When you get that figured out, record those actions in a macro to get the starting point for your syntax. The code on the Excel side for writing the data across will essentially stay the same.
You'll also need to decide where the code should reside: in Word or in Excel. That will mean researching how to run the other application from within the one you choose - lots of examples here on SO and on the Internet...

Excel VBA, multi parameter filter to return row ID

I currently have an algorithm that manipulates data on sheet 24 in my excel workbook. I have 3 integers, a, b, and c, that come from data on sheet 24, and I need to use them to return a unique row ID on sheet 14. A, B, and C, each represent their corresponding Column (range) on sheet 14 IE: Int a from sheet 24 is in column A on sheet 14. Int b in column b, and c in c. The numbers combined will always return a singular row ID from 14, in the case, integer row. I'm having a hard time writing a statement with Filter, evaluate, and a bunch of other Excel functions. Does anyone know how to launch a script from an algorithm executing on one sheet and just pull a row ID in sheet 14 using its' resulting three search numbers for a,b,c?
row = Sheets("Physical Disk Details").Columns("A").Find(what:=a, LookIn:=xlValues, lookat:=xlWhole) * Sheets("Physical Disk Details").Columns("B").Find(what:=b, LookIn:=xlValues, lookat:=xlWhole) * Sheets("Physical Disk Details").Columns("C").Find(what:=c, LookIn:=xlValues, lookat:=xlWhole)
This Function will return the first row number that is found to exactly match what is provided for a,b, and c. It demonstrates one of the simplest Range iteration and If/Then tests that forms the foundation of most data pattern searching subroutines you will find for Excel VBA. There are ways to streamline this code but it demonstrates the basic principle.
If you read every line of this code and understand what all of it does you can use the principles to accomplish most tasks even vaguely similar to it.
Function GetRowNumberByABCMatch(a As Integer, b As Integer, c As Integer) As Integer
Dim lastRowInDataSet As Integer
Dim i As Integer
'get last row containing data in column 1
lastRowInDataSet = Sheets("Physical Disk Details").Cells(Rows.count, 1).End(xlUp).Row
'i = current row number, start at row 1
For i = 1 To lastRowInDataSet
If Sheets("Physical Disk Details").Range("A" & i).Value = a _
And Sheets("Physical Disk Details").Range("B" & i).Value = b _
And Sheets("Physical Disk Details").Range("C" & i).Value = c Then
'all fields match, return the current row number
GetRowNumberByABCMatch = i
'stop processing and return because we found a single match
Exit Function
End If
Next i
'didn't find a matching row, return -1
GetRowNumberByABCMatch = -1
End Function

Non repeating positive random numbers, over a given range

am generating a game using vb 6.0, at one face i need to generate non repeating random numbers between 1 and 100. am using the following code for generating the random numbers
dim n(10) as integer
for i=0 to 9
n(i)=round(rnd*100)
next i
the code is within a for loop hence it generate 10 Nos. randomly, but it includes repeating numbers and also '0', is their any suggestion to avoid repeating numbers and '0'
then output of my code is:
n()={42,14,10,22,5,42,12,0,59,72}
the numbers 42 is appear two times in the array and 0 cannot be avoided
thanks in advance
Here is a simple technique
Dim n(10) As Integer
Dim choice(100) As Integer
' Create a list of possible numbers
For i = 0 To 100
choice(i) = i
Next
' Populate the array with unique numbers
For i = 1 To 10
lastix = 101 - i
' Find one that has not been selected
ix = Round(Rnd * lastix)
' Assign it
n(i) = choice(ix)
' Replace with one that has not been used
choice(ix) = choice(lastix)
Next
You can use the same technique for shuffling cards.
To avoid 0, multiply by 99 and add 1. To avoid duplicates, keep track of what you generated and retry if you get a duplicate. (Since you need only a few numbers. If you need many, shuffle an array of all possible outcomes and take the initial members.)
the solution below is not the fastest, but makes up by that for being easy ...
it uses a hidden listbox control which contains the required values and retreives a random one every time
the values in this example are just the squared numbers of the index
run the project and click the command button to see what happens. it should show messageboxes with the square numbers in random order
'1 form with:
'1 listbox control : name=List1
'1 command button : name=Command1
Option Explicit
Private Sub Command1_Click()
Dim intIndex As Integer
'generate a new random sequence every time
Randomize Timer
'loop through the list and retreive 1 random value at a time
With List1
Do While .ListCount > 0
intIndex = Int(Rnd * .ListCount)
MsgBox .List(intIndex)
'remove the used item from the list
.RemoveItem intIndex
Loop
End With 'List1
End Sub
Private Sub Form_Load()
Dim intIndex As Integer
'hide listbox
List1.Visible = False
'fill listbox with values (squares)
List1.Clear
For intIndex = 1 To 10
List1.AddItem CStr(intIndex * intIndex)
Next intIndex
End Sub
btw i am just using 10 numbers so you dont have to click through 100 messageboxes :)

Excel VBA: Writing an array to cells is very slow

I am working with VBA in Excel to retrieve some information from the Reuters 3000 Database. The data I retrieve comes as a bidimensional array consisting of one column holding dates and other column holding numeric values.
After I retrieve the information, a process that takes no more than 2 seconds, I want to write this data to a worksheet. In the worksheet I have a column with dates and several other columns with numeric values, each column containing values of a same category. I iterate over the rows of the array to get the date and numeric value and I keep those in a variable, then I search for the date on the date column of the worksheet and after I've found the date I write the value. Here is my code:
Private Sub writeRetrievedData(retrievedData As Variant, dateColumnRange As String, columnOffset As Integer)
Dim element As Long: Dim startElement As Long: Dim endElement As Long
Dim instrumentDate As Variant: Dim instrumentValue As Variant
Dim c As Variant: Dim dateCellAddress As Variant
Application.ScreenUpdating = False
Sheets("Data").Activate
startElement = LBound(retrievedData, 1): endElement = UBound(retrievedData, 1)
Application.DisplayStatusBar = True
Application.StatusBar = "Busy writing data to worksheet"
For element = startElement To endElement
instrumentDate = retrievedData(element, 1): instrumentValue = retrievedData(element, 2)
Range(dateColumnRange).Select
Set c = Selection.Find(What:=instrumentDate, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not c Is Nothing Then
c.offset(0, columnOffset).Value = instrumentValue
End If
Next element
Application.DisplayStatusBar = False
End Sub
My problem is that this process is very slow, even if I have only 5 rows in the array it takes about 15 seconds to complete the task. As I want to repeat this process several times (once per each set of data I retrieve from the database), I would like to decrease the execution time as much as possible.
As you can see, I am disabling the update of the screen, which is one of the most recurrent actions to improve performance. Does anybody have a suggestion on how I can further decrease the execution time?
PS. I know the data retrieval process does not take much because I already tested that part (displaying values on a MsgBox as soon as the data has been retrieved)
Thanks in advanced.
This is what I did to improve the performance:
Avoid selecting the cell when the value is going to be written. This was a suggestion of Tim Williams.
I set the property Application.Calculation to xlCalculationManual
Instead of using the Find() function to search for the date, I loaded all the dates from the worksheet into an array and iterate over this array to get the row number. This turns out to be faster than the Find() function.
Private Function loadDateArray() As Variant
Dim Date_Arr() As Variant
Sheets("Data").Activate
Date_Arr = Range(Cells(3, 106), Cells(3, 106).End(xlDown))
loadDateArray = Date_Arr
End Function
Private Function getDateRow(dateArray As Variant, dateToLook As Variant)
Dim i As Double: Dim dateRow As Double
For i = LBound(dateArray, 1) To UBound(dateArray, 1)
If dateArray(i, 1) = dateToLook Then
dateRow = i
Exit For
End If
Next i
getDateRow = dateRow
End Function
Thank you all for your help!
By not selecting the sheet, you can add a bit more speed. Instead of
Sheets("Data").Activate
Date_Arr = Range(Cells(3, 106), Cells(3, 106).End(xlDown))
loadDateArray = Date_Arr
Try
With Sheets("Data")
Date_Arr = .Range(Cells(3, 106), Cells(3, 106).End(xlDown))
End With

Resources