Form launchs a procedure without filling cells beforehand - vba

I've written a procedure that should determine some values, enter them in specific cells and launch a procedure that depends on these same cells.
It worked once, but then the proc started to act like the cells were empty.
The form contains three textboxes (ratebox, amountbox, cfbox), as well as one combobox:
Private Sub CommandButton1_Click()
If ratebox.value = "" Or amountbox.value = "" Or numbercfbox.value = "" Or cfbox.value = "" _
Or Not IsNumeric(ratebox.value) Or Not IsNumeric(amountbox.value) Or Not IsNumeric(cfbox.value) Or Not IsNumeric(numbercfbox.value) Then
MsgBox "valeur"
Exit Sub
End If
Cells(3, 1) = ratebox.value / 100
Cells(3, 2) = amountbox.value
For i = 1 To numbercfbox.value
Cells(3, i + 2) = cfbox.value
Next
callproc_e1
Unload form_e1
End Sub
The procedure starts with:
Sub e1s1()
rate = Cells(3, 1)
amount = Cells(3, 2)
numbercf = Cells(3, 3).End(xlToRight).column - 2
'MsgBox (rate & Chr(10) & amount & Chr(10) & numbercf)
ReDim cf(numbercf) As Double
I've tried registering the box values in variables and entering the variables in the cell before launching the procedure, doesn't work.
I've put a msgbox with all the values just before launching the procedure:
Cells(3, i + 2) = cfbox.value
Next
MsgBox (ratebox.value & Chr(10) & amountbox.value & Chr(10) & numbercfbox.value & Chr(10) & cfbox.value)
callproc_e1
When the msgbox appears, I can see that the values are written down in the cells, but the procedure still acts like these cells are empty: numbercf is 16382.

Your code will fill cells in the active worksheet of the active workbook. If it fails sometimes, you should specify the sheet with lines like:
Sheets("Sheet1").Cells(3, 1) = ratebox.value / 100

I've finally located the problem: in my call sub, the first action was to delete all cells.
Thanks to all those who tried to help.

Related

VBA - use a sub or function

I have written a code for a command button in VBA that uses a (column) range as input and has a (column) range as output. I want to use the same code for other command buttons that refer to other columns. I do not want to repeat the entire code, as only the reference to the columns changes.
I cannot figure out how to define this code as a function or sub that I can 'call' in the code for other command buttons which execute the code on columns B, C, D, etc.
This is the code. It removes duplicates and adds the string "rename" to each element of the list:
Private sub rename_column_A_Click()
'copy values of sheet1 column A to active sheet
Range("A1:A30").Value = Worksheets("sheet1").Range("A1:A30").Value
'remove duplicates, keeping first value as column header
Columns("A:A").Select
ActiveSheet.Range("$A$2:$A$30").RemoveDuplicates Columns:=Array(1), _
Header:=xlNo
Range("A" & 2).Select
'add string to each element of list
For i = 2 To 30
If Not Range("A" & i).Value = "" Then
Range("A" & i).Value = "rename " & Range("A" & i).Value
End If
Next i
End Sub
Like John Coleman suggests, you can have your Sub take a Range parameter:
Private Sub rename_column_A_Click()
ProcessRange "A"
End Sub
Private Sub rename_column_B_Click()
ProcessRange "B"
End Sub
Sub ProcessRange(ColAddress As String)
'copy values of sheet1 column A to active sheet
Range(ColAddress & "1:" & ColAddress & "30").Value = Worksheets("sheet1").Range(ColAddress & "1:" & ColAddress & "30").Value
'remove duplicates, keeping first value as column header
ActiveSheet.Range("$" & ColAddress & ":$" & ColAddress & "$30").RemoveDuplicates Columns:=Array(1), Header:=xlNo
'add string to each element of list
For i = 2 To 30
If Not Range(ColAddress & i).Value = "" Then
Range(ColAddress & i).Value = "rename " & Range(ColAddress & i).Value
End If
Next i
End Sub
I removed the two Select lines of code. I don't think you need them.

Excel Macro to Concatenate Rows of Variable Lengths with Delimiter

I'm developing a worksheet users can fill out to generate a file that can be uploaded into SAP.
The worksheet will generate a mass upload of individual entries. Users will be asked to provide attributes for each line item they are requesting, which may vary based on the selection made (i.e. one row may have 5 attributes while the next may have 7).
I want to write a macro that will look at each row, starting from the top, and concatenate only the attribute columns (which are separated by two other columns in each instance) which are not blank and use a delimiter between each field.
I've been able to use some code I found through Microsoft to get the looping done (see below), but I can't figure out how to have the concatenate stop when a column is blank and then move to the next row.
Sub Submit()
Range("C2").Activate
Do While ActiveCell <> ""
ActiveCell.Offset(0, 21).FormulaR1C1 = _
ActiveCell.Offset(0, 0) & "-" & ActiveCell.Offset(0, 3) & "-" &
ActiveCell.Offset(0, 6) & "-" & ActiveCell.Offset(0, 9) & "-" & ActiveCell.Offset(0, 12) & "-" & ActiveCell.Offset(0, 15) & "-" & ActiveCell.Offset(0, 18)
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Right now, this code will take a five attribute entry and leave me with "1-2-3-4-5--", when I really want it to show up as "1-2-3-4-5".
Any thoughts on how I can go about doing this? Eventually, I want to be able to store those strings and populate them in a new workbook with some other information copied over from the original workbook.
Untested:
Sub Submit()
Dim c As Range, c2 As Range, v as String
Set c = Range("C2")
Do While c.Value <> ""
Set c2 = c
v = ""
Do While c2.value <> ""
v = v & IIf(v <> "", "-", "") & c2.value
Set c2 = c2.offset(0, 3)
Loop
c.offset(0, 21).Value = v
Set c = c.Offset(1, 0)
Loop
End Sub
This is a quick answer, so may not have everything you're after:
Public Function Submit(Target As Range) As String
Dim sFinalOutput As String
Dim rCell As Range
'Cylce through each cell in your range.
For Each rCell In Target
'Look at the column number divided by 3 - if it's 0 then carry on.
If rCell.Column Mod 3 = 0 Then
If rCell.Value2 <> "" Then
'Grab the value from the cell and add it to the final output.
sFinalOutput = sFinalOutput & "-" & rCell.Value2
End If
End If
Next rCell
Submit = sFinalOutput
End Function
Use it in a formula such as: =submit(C4:L4)

excel hyperlink to nothing

I've got a lot of hyperlinks and I want to assign a macros to each of them and Worksheet_FollowHyperlink captures only Inserted Hyperlinks but not the HYPERLINK() function. So I want my Inserted Hyperlinks refer to nothing so when I press them nothing happens. Or I want them to refer themselves. But when I just copy one to another cell it still refers to its parents cell. So I have to edit a new one so it refers to its new cell. And I've got hundreeds of hyperlinks to be copied and edited as well. I need that because I don't want the hyperlinks skip me to the parent hyperlink's cell.
Thanks in advance
You will be better off using the HYPERLINK() function. You can use it for what you want like this:
=HYPERLINK("#HyperlinkClick()", "Text you want to Display")
Notice the # at the beginning. This is important.
Now create a function called HyperlinkClick:
Function HyperlinkClick()
Set HyperlinkClick = Selection
'Do whatever you like here...
MsgBox "You clicked on cell " & Selection.Address(0, 0)
End Function
Be sure to place this function in a STANDARD CODE MODULE.
That's it.
I've just founded a solution. If I refer my Inserted Hyperlink to some cell in other sheet and then make it very hidden (xlSheetVeryHidden), it works just perfect. Now my hyperlinks refer to the Neverland and the macro captures them as well. Thank you all for your patiense.
Good solution Excel Hero but not for everything: I try to make a kind of outline but it's impossible to hide a row in the function: nothing happen! But if a make a direct call to the same code with a button, everything works fine. This is my test:
Function test()
Set test = Selection
Dim i, j, state As Integer
state = Selection.Value
i = Selection.Row + 1
j = i
If state = "6" Then
Do Until ActiveSheet.Cells(j, 7).Value = 1 Or ActiveSheet.Cells(j, 4).Value = ""
j = j + 1
Loop
ActiveSheet.Rows(i & ":" & j - 1).EntireRow.Hidden = True
Debug.Print "test group: " & i & ":" & j - 1
Else
Do Until ActiveSheet.Cells(j, 7).Value = 1 Or ActiveSheet.Cells(j, 4).Value = ""
j = j + 1
Loop
ActiveSheet.Rows(i & ":" & j - 1).EntireRow.Hidden = False
Debug.Print "test ungroup: " & i & ":" & j - 1
End If
End Function
My debug.print give me this:
test group: 4:26
Select a group of cells and run:
Sub HyperAdder()
For Each r In Selection
ActiveSheet.Hyperlinks.Add Anchor:=r, Address:="", SubAddress:=r.Parent.Name & "!" & r.Address(0, 0), TextToDisplay:="myself"
Next r
End Sub

Excel VBA -> Userform to pick up information under loop

I am a noob when it comes to Userform creation, please kindly help.
- note: this is my first time posting and can't seem copy over of what I have on to this post
simplified example of my current sheet:
Col A = Product Name
Col B = Qty in inventory
Col C = Allocation of product (say into different baskets)
Row 1= Apple / 10 / #1
Row 2= Orange / 10 / 5 in #2, 5 in #e
This is my biggest issue.
When I run my code:
for I = 1 to lastrow
if range("C" & I) <> "#1" then
userform1.show
end if
next I
what I want to do at this point is to set label1.caption = range("C" & I) <--- ie making it dynamic
so when the user clicks submit/ok (which should split the info into 2 separate lines instead of 1), it would go next I (to the next line) that has the allocation that is NOT #1
thanks for all your help in advance!!
I think it's easier to pass the value directly:
For I = 1 To lastrow
If Range("C" & I).Value <> "#1" Then
Load UserForm1
UserForm1.Label1.Caption = Range("C" & I).Value
UserForm1.Show
End If
Next I
To be able to pass the value of "I" to your userform, declare it at the very top of your module, before the word "Sub":
Public I As Integer
Sub SearchRows()
For I = 1 To 5
If Range("C" & I) <> "#1" Then
UserForm1.Show
End If
Next I
End Sub
Then in the code for your userform:
Private Sub UserForm_Initialize()
Label1.Caption = Sheets("Sheet1").Range("C" & I)
End Sub
This will cycle through the values in column C that are not #1.

Different behavior in VBA when in debug mode (steps) or in automatic mode

I have a Excel Macro which makes Hyperlinks in the first column of a table.
When i run it step by step in manual mode, it works fine and the hyperlinks are created.
When i run it in automatic mode, it runs without any error but the hyperlinks are not created.
I do not have any ideas why...?
Public Sub aktualisieren()
Call Column_MakeHyperlinks(1)
End Sub
and then
Sub Column_MakeHyperlinks(Blatt)
' ### Start Tabellenanalyse ###
' - Länge
' - Start
' - Ende
On Error Resume Next
Set WS = Sheets(Blatt) '
Set Tabelle = WS.ListObjects(1) ' Get Table
Anzahl = Tabelle.ListRows.Count ' Number of Rows in Table
Start = Tabelle.ListRows(1).Range.Row ' First Row in Table
Ende = Tabelle.ListRows(Tabelle.ListRows.Count).Range.Row ' Last Row in Table
sMsg = "There are " & Anzahl & " Rows in '" & Tabelle.Name & "'. "
sMsg = sMsg & DNL & "Start in Row " & Start
sMsg = sMsg & NL & ", Ende in Row " & Ende
'MsgBox sMsg, vbInformation, UCase(sTableName) ' Activate for Text-Output
' ### Ende Tabellenanalyse ###
iRow = Start ' Start at first Row with content
iCol = 1 ' Column A
' Parameters, which should be concatenated to the link are in column A
WS.Hyperlinks.Delete
Do While WS.Cells(iRow, iCol).Value <> ""
' create Hyperlink (fixed prefix and dynamic parameter
Temp = WS.Cells(iRow, iCol).Value
'WS.Cells(iRow, iCol).Select ' Not necessary, only to make active cell visible in manual mode
WS.Hyperlinks.Add Anchor:=WS.Cells(iRow, iCol), Address:="https://www.google.de/?gws_rd=ssl#q=" & ActiveSheet.Cells(iRow, iCol).Value, _
TextToDisplay:=Temp, _
ScreenTip:="https://www.google.de/?gws_rd=ssl#q=" & ActiveSheet.Cells(iRow, iCol).Value
'move to the next row
iRow = iRow + 1
Loop
End Sub
Can anyone explain me why? Thanks in advance!
For me your code works, hyperlinks are created, but seem to be "inactive".
I added:
WS.Cells(iRow, iCol).Value = WS.Cells(iRow, iCol).Value
before iRow increment which solved the problem of hyperlinks "activity".
Also the way you iterate through cells of listobject's column should be rather like:
For Each c In Tabelle.ListColumns("column_name").DataBodyRange
Temp = c.Value
WS.Hyperlinks.Add Anchor:=c, Address:="https://www.google.de/?gws_rd=ssl#q=" & c.Value, _
TextToDisplay:=Temp, _
ScreenTip:="https://www.google.de/?gws_rd=ssl#q=" & c.Value
c.Value = c.Value
Next
i found my problem: I got the Data in the first Column from a Database. When i do the refresh, it runs in the Background and the links are created while the data is still imported.
I found a checkbox "Allow Background actualization" in the "Connections" menu and unchecked it. This and the Answer of user avb solved my problem.
thanks !!