Loop textboxes and cells - loops

I need some help making this code shorter. I have a lot of textboxes with times in my form which I want to copy to my Excel file. Some of the boxes needed to be 15min less in Excel sheet and I want to loop through these textboxes and and copy the result into the correct cell. My code works but I want to make it for more textboxes at once.
Dim d1re1 As Date = TextBox5.Text
TextBox5.Text = d1re1.ToLongTimeString()
Dim d1nre1 As Date = d1re1.AddMinutes(-15)
xlsp1.Cells(7, 100) = d1nre1.ToLongTimeString
Dim d1re2 As Date = TextBox7.Text
TextBox7.Text = d1re2.ToLongTimeString()
Dim d1nre2 As Date = d1re2.AddMinutes(-15)
xlsp1.Cells(7, 102) = d1nre2.ToLongTimeString

The idea here that the lines somehow doing the same but with different parameters.
Here functions come in the picture. You can just create generic method call it for ex : SetDateToFieldscand takes the parameters : the source textbox and which cell it needs to update.
Like this you just need only to call the method with different params.

Related

Can't copy a value from one worksheet over to an array in another worksheet

In the same workbook, I've got two worksheets: Model and Results.
My goal is to copy the value of a cell in Model (for e.g., F8) over to a cell in an array (c4 to I23) in Results called ResultsArray (see code below).
When I run my module, no error appears, but the code doesnt seem to work either (the value of F8 doesnt get copied over to the specified cell in ResultsArray).
Appreciate any help.
Tried running different variations of the code below
Sub CopyTest()
Dim ResultsArray As Variant
ResultsArray = Worksheets("Results").Range("C4:I23")
ResultsArray(1, 1) = Worksheets("Model").Range("F8").Value
End Sub
I'm using ResultsArray(1,1) because I am hoping to introduce a loop into the code to populate cells in the array based on the loop counter, e.g., ResultsArray(loopcounter,1)
So turns out I just needed to add "Set" in the 2nd line before "ResultsArray" when assigning the range from the worksheet "Model" to it:
Sub CopyTest()
Dim ResultsArray As Variant
Set ResultsArray = Worksheets("Results").Range("C4:I23")
ResultsArray(1, 1) = Worksheets("Model").Range("F8").Value
End Sub
I've tested this addition and it works

VBA Excel 2013: Assign Array Values from Another UserForm

I'm relatively new to VBA. I have a program I'm writing where the user is given the option to change their input from a 2 dimensional array in another user form.
The first user form, UserForm1, allows the user to input the information from text fields and saves it to the respective array row, i, when pressing a Save command button.
When the user presses an OK command button, the user is asked if they want to add another set of data. If they say no, they are asked if they want to change data. If they say yes, then another user form, UserForm2, is opened.
The code for UserForm1 is similar to the code below:
Public MyArray as Variant, i as Integer
Sub Userform_Initialize()
ReDim MyArray(100,4)
End Sub
Sub SaveButton_click()
MyArray(i, 1) = TextField1.Value
MyArray(i, 2) = TextField2.Value
MyArray(i, 3) = TextField3.Value
MyArray(i, 4) = TextField4.Value
End Sub
Sub OKButton_click()
If msgbox("Do you want to add more data?", vbYesNo) = vbNo Then
If msgbox("Do you have corrections to be made?",vbYesNo) = vbYes Then
Load UserForm2
UserForm2.Show
Else: Exit Sub
End If
Else: i = i + 1
Exit Sub
End If
End Sub
In UserForm2, the user chooses the row number, i, from a combo box. When the row number is selected, the array information is automatically populated in text fields from UserForm1.
When the user presses the Save command button, it should pass the information from the text fields and write it to the respective row.
The code for UserForm2 is similar to the code below:
Public j as integer
Sub Userform_Initialize()
For j = 1 to UserForm1.i
ComboBox1.AddItem (j)
Next
End Sub
Sub SaveButton_click()
UserForm1.MyArray(ComboBox1.Value, 1) = TextField1.Value
UserForm1.MyArray(ComboBox1.Value, 2) = TextField2.Value
UserForm1.MyArray(ComboBox1.Value, 3) = TextField3.Value
UserForm1.MyArray(ComboBox1.Value, 4) = TextField4.Value
End Sub
Stepping through the code, the values from MyArray should be properly referenced, and I can see the values initially saved from UserForm1. However, the values are not changing as I step to the next line.
Does anyone have a solution for my problem? Thank you in advance for your help!
I believe I found my solution. I had to declare the array in the module containing the code to start the program as a public variable. After I did that and modified the code, the values were written properly to the array.
If anyone has other solutions, though, I would like to know. I'm not that experienced with VBA, so I want to hear other solutions.

Allow edits from different users appear in different color inside memo box : Microsoft Access 2010

I have a memo field which contains rich text. I am able to identify a user and change all the text in the box instead of just the text they added.
I am looking to write code which allows the text to be edited and after update , the edited text will appear a different color than the original text in the memo field.
I have tried :
Dim strNew As String
Dim strOld As String
If Me.txt_username_id = "grant" Then
strOld = Me.Form!txtnotesaboutproduct1.OldValue.ForeColor = vbBlack<br/>
strNew = Me.Form!txtnotesaboutproduct1.ForeColor = vbRed
End If
I have also tried
Dim ctlOld As TextBox<br/>
Set ctlOld = Me.Form!txtnotesaboutproduct1
If Me.txt_username_id = "grant" Then
ctlOld = Me.Form!txtnotesaboutproduct1.OldValue.ForeColor = vbRed
End If
Generally, I do this with a continuous subform for Notes, so that I can hold the data, date and user, rather than just one formatted text box. Though I do realize this might be a lot more real estate that you might have, you can use a conditional format within the subform. I do agree that if it is possible, you'll likely need to use HTML and not .Forecolor, which will change the entire box.

Loop through Textboxes in access database

I have an Access database that I want to loop through certain textboxes in order to do a calculation and display the answer in a seperate textbox. When I attempt to loop it loops through every control on my form (with the Form.Controls) method. I would like to only loop through 4 specific textboxes (txtbx1, txtbx2, txtbx3, txtbx4) when my button is clicked.
Explanation...
TextBox_A contains a Number
Upon button click take the number from TextBox_A, Multiply by 2800, then Divide by 12
Display the answer to the calculation in txtbx1.
I would do this for each of the 4 textboxes named above. Then have a "Total" textbox that adds up the total from each textbox (txtbx1, txtbx2, txtbx3, txtbx4). Please help, new to this and at a complete loss.
Every control has got a Tag property. Set the Tag property for textboxes whose values you want to include in your algorithm (say to "INClUDE"). It's free format text, so you can put what you like.
Then write code attached to some form event similar to this:
Dim c As Control
Dim txt As TextBox
For Each c In Me.Controls
'check it's a text box ...
If TypeOf c Is TextBox Then
'see if including ...
Set txt = c
If Len(txt.Tag) > 0 Then
'do something here (I've coloured, to show works)
txt.BackColor = 10
End If
End If
Next c
I've set an extra variable txt to refer to the textbox in question, so that I can get at the TAG property using autocompletion (I believe this is called a narrowing conversion!).
It would be easier if you rename TextBox_A (_B / _C etc) to TextBox_1 / _2 / _3 etc.
And then try this:
Dim i As Integer
For i = 1 To 4
Controls("txtbx" & i) = Val(Controls("TextBox_" & i)) * 2800 / 12
Next
Otherwise, this would work too, but it is not well readable:
= Val(Controls("TextBox_" & Chr(Asc("A") + i - 1))) * 2800 / 12

How to fill-up cells within a Excel worksheet from a VBA function?

I simply want to fill-up cells in my spreadsheet from a VBA function. By example, I would like to type =FillHere() in a cell, and in result I will have a few cells filled-up with some data.
I tried with such a function:
Function FillHere()
Dim rngCaller As Range
Set rngCaller = Application.Caller
rngCaller.Cells(1, 1) = "HELLO"
rngCaller.Cells(1, 2) = "WORLD"
End Function
It breaks as soon as I try to modify the range. Then I tried this (even it's not really the behavior I'm looking for):
Function FillHere()
Dim rngCaller As Range
Cells(1, 1) = "HELLO"
Cells(1, 2) = "WORLD"
End Function
This is not working neither. But it works if I start this function from VBA using F5! It seems it's not possible to modify anything on the spreadsheet while calling a function... some libraries do that though...
I also tried (in fact it was my first idea) to return a array from the function. The problem is that I only get the first element in the array (there is a trick that implies to select a whole area with the formula at the top left corner + F2 + CTRL-SHIFT-ENTER, but that means the user needs to know by advance the size of the array).
I'm really stuck with this problem. I'm not the final end-user so I need something very easy to use, with, preferably, no argument at all.
PS: I'm sorry I asked this question already, but I wasn't registered at that time and it seems that I can't participate to the other thread anymore.
You will need to do this in two steps:
Change your module to be something like:
Dim lastCall As Variant
Dim lastOutput() As Variant
Function FillHere()
Dim outputArray() As Variant
ReDim outputArray(1 To 1, 1 To 2)
outputArray(1, 1) = "HELLO"
outputArray(1, 2) = "WORLD"
lastOutput = outputArray
Set lastCall = Application.Caller
FillHere = outputArray(1, 1)
End Function
Public Sub WriteBack()
If IsEmpty(lastCall) Then Exit Sub
If lastCall Is Nothing Then Exit Sub
For i = 1 To UBound(lastOutput, 1)
For j = 1 To UBound(lastOutput, 2)
If (i <> 1 Or j <> 1) Then
lastCall.Cells(i, j).Value = lastOutput(i, j)
End If
Next
Next
Set lastCall = Nothing
End Sub
Then in order to call the Sub go into the ThisWorkbook area in VBA and add something like:
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Call WriteBack
End Sub
What this does is return the value of the topleft cell and then after calculation completes populates the rest. The way I wrote this it assumes only one FillHere function will be called at a time. If you want to have multiple ones which recalculate at the same time then you will need a more complicated set of global variables.
One word of warning is that this will not care what it overwrites when it populates the other cells.
Edit:
If you want to do this on a Application wide basis in an XLA. The code for the ThisWorkbook area should be something like:
Private WithEvents App As Application
Private Sub App_SheetCalculate(ByVal Sh As Object)
Call WriteBack
End Sub
Private Sub Workbook_Open()
Set App = Application
End Sub
This will wire up the Application Level calculation.
What you're trying to do won't work in Excel - this is by design.
You can do this, though:
Function FillHere()
Redim outputArray(1 To 1, 1 To 2)
outputArray(1, 1) = "HELLO"
outputArray(1, 2) = "WORLD"
FillHere = outputArray
End Function
If you then select two adjacent cells in your worksheet, enter =FillHere() and press Control+Shift+Enter (to apply as an array formula) then you should see your desired output.
Fundamentally, a function can only affect the cell it is called from. It sounds like you may need to look at using the Worksheet_Change or Worksheet_SelectionChange events to trigger the modification of cells in the intended range.
You can do this indirectly using a 2-stage process:
Write your UDF so that it stores data in a sufficiently persistent way (for example global arrrays).
then have an Addin that contains application events that fire after each calculation event, looks at any data stored by the UDFs and then rewrites the neccessary cells (with warning messages about overwrite if appropriate) and reset the stored data.
This way the user does not need to have any code in their workbook.
I think (but do not know for sure) that this is the technique used by Bloomberg etc.

Resources