Excel VBA -> Userform to pick up information under loop - vba

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.

Related

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

merge cells based on value of another cell with VBA

I've been working on a project and I'm trying to make things go smoother :)
I have an excel sheet with several columns and as you can see it below, Column C is the importance of the topic(based on information typed in that row) and Column D is whether the information typed is a new information or an update regarding the previous (upper) row. Soo:
if I type "update" on column D, row 3; I want it to automatically merge the cells C2 and C3.
C D
1 LOW new
2 HIGH new
3 update
4 Low new
5 update
6 update
I don't know how to write VBA codes but I can mostly understand the codes enough to adopt what I find on internet to what I want to achieve. I have checked so many websites to find whatever I needed but I had no luck so I would really appreciate if you could help me :)
Try this :
Sub Merge_Priority()
Dim RgToMerge As String
For i = 1 To ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
RgToMerge = ""
If LCase(Cells(i, 4)) <> "update" Or (LCase(Cells(i + 1, 4)) <> "new" And Cells(i + 1, 4) <> "") Then
Else
RgToMerge = "$C$" & Cells(i, 3).End(xlUp).Row & ":$C$" & i
With Range(RgToMerge)
.Merge
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
End If
Next i
End Sub
Do you know how to add a macro on an event?
Go to Visual Studio, select ThisWorkBook on the left and create a macro with this :
Private Sub Worksheet_Change()
And paste the code right above
You can try something like this add this Macro in the Current Sheet.
Private Sub Worksheet_Change(ByVal Target As Range)
IF Target.value = "Update" then
Range("A" & Target.row - 1 & ":A" & Target.row).Merge
End If
End Sub

excel VBA : how to skip blank cells between 2 cells that contain values?

I am working out a button that can auto sum value at column C that column A = column B
like the picture :
PIC:
I can only copy the value in column C (that the word in column A = column B) to column E so far.
the code
Private Sub CommandButton2_Click()
Dim i As Integer, q As Integer
q = 2
For i = 3 To 100
Range("E" & q).Value = Range("b" & 3).Value
If Range("B" & i).Value = "A-RDL1" And Range("c" & i).Value = "OPEN" Then
Range("E" & i).Value = Range("d" & i).Value
End If
Next i
End Sub
the question 1) is how can I skip the blanks E9 to E17, so the numbers can be continuous? (AFTER CLICK THE BOTTON)
question 2) is it possible to auto sum the Numbers in column E instead of show each?
Thanks a lot and sorry for my poor English...
1) Yes, you can skip those, just carry out a check in the cell value and compare to empty string: Range("").Value2 = "". I personally prefer to do it like this though, to avoid false positives: Len(Trim(Range("").Value2)) = 0.
2) Yes, you can do that. just declare an Integer variable or two and use that to carry out a running count of your values.

Stuck with a loop. After it fulfilled its function it keeps on going

The first code is there to see if the number 20 is already in the spaces B28 till B47. If that is the case, I want it to move on to the next step. If the number 20 is not there, then i would like it to add the number to line B47 and then end after completing that. I'm haing problems trying to get it to stop after it added the number 20. Instead of ending, it continues down the column and adds een more 20s due to it not finidng any. What I have been trying to create is a loop which checks all the cells first, and if it does not find 20 it adds it once, instead of adding it 20 times.
The second code I hae after this is there to try to delete all empty rows in B28 till B47. However, it does not do that and skips this loop entirely moving to Blargh3 instead. I have tried creating loops for this, but Excel has always been giving me an error with it. I have tried researching as to how I could fix it after i have tried myself. I was not able to find anything which helped me.
As I am quite new to VBA, help would be greatly appreciated.
For Each Cell In Worksheets("Sheet1").Range("B28:B48")
If Cell.Value > 19 Then
GoTo Blargh2
Else:
Range("B" & 47, "BM" & 47).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B" & 47) = 20
Dim a As Long
For a = 3 To 65
Cells(47, a) = 3
Next
End If
Next
Blargh2:
For Each Cell In Worksheets("Sheet1").Range("B28:B47")
If Cell.Value = 0 Then
Row.Delete X1DeleteShiftUp
Else:
GoTo Blargh3
End If
Next
Blargh3:
Dim i As Long
For i = 47 To 29 Step -1
If Range("B" & i) - Range("B" & i).Offset(-1, 0) > 1 Then
Range("B" & i, "BM" & i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B" & i) = Range("B" & i).Offset(1, 0) - 1
Dim c As Long
For c = 3 To 65
Cells(i, c) = 3
Next
i = i + 1
End If
Next
Turn on your Immediate Window -> ctrl+g or in the menu bar click View => Immediate Window
This would be the first part based on your logic
Sub FirstPart()
Dim is20There As Range
With Range("B28:B47")
Set is20There = .Find(What:="20", LookIn:=xlValues, lookat:=xlPart)
End With
If is20There Is Nothing Then
Debug.Print "20 is not there, executing your code now"
Range("B" & 47, "BM" & 47).Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B" & 47) = 20
Dim a As Long
For a = 3 To 65
Cells(47, a) = 3
Next
Else
Debug.Print "exiting because 20 is there"
End If
End Sub
What happens here in the first loop is
using the .Find function in range B28:B47 to find the value of 20. If the value is there then the Else part of the loop will execute which simply does nothing but prints a message to the Immediate Window that 20 has been found.
this is when the 20 is not there
If 20 is not found (If is20There is Nothing evaluates to True) then you can execute your code which I guess adds a row at B47 (shifting the last row down ) and fills the cells with number 3 all the way down to 65th column except the B column which you seem to assign number 20 to.
So if 20 is not there the code literally does nothing.
this is when 20 is there (nothing happens)
The second part loops through B28:B47 backwards ( starting form the end to beginning ) and deletes the entire rows if any of them are empty ( column B only )
this is before
then run the code
Sub SecondPart()
Dim i As Long
Dim cell As Range
For i = 47 To 28 Step -1
Set cell = Range("B" & i)
If IsEmpty(cell) Then
Rows(cell.Row & ":" & cell.Row).Delete shift:=xlUp
End If
Next i
End Sub
and this is after

Extract data from a two columned listbox to a sheet

I have a two-columned listbox, which I've manually added entries to using
.AddItem (potato)
.List(.ListCount - 1, 1) = bananaTbx.Text
When the user closes the userform all of the data is lost, so I want to have a save & exit button which saves the data to a sheet. However, it can't be saved to specific cells as the size of the list is dynamic and they will continually be adding to the master list in the sheet.
I tried to do something like this to extract the data:
Dim i As Integer
'loop through each row number in the list
For i = 0 To Userform1.Listbox1.ListCount - 1
'create sequence 1,1,2,2,3,3,4,4 ... to reference the current list row
j = Application.WorksheetFunction.RoundDown(i + 0.5, 0)
'create sequence 0,1,0,1,0,1,0,1 ... to reference current column in list
If Len(CStr(i / 2)) > 1 Then
k = 0
Else
k = 1
Sheets("Data").Range("A1" & ":" & "A" & i).Value = Userform1.ListBox1.List(j, k)
End If
Error:
1004 Object defined error
How can I do this properly or in a more efficient manner?
I have created a simple userform to demonstrate how to Extract Values / Data from a multi-column Listbox on a Userform
Start by creating a simple userform with a few controls
add a new Module1 to your Project and stick the below code in it
Sub TestUserForm()
UserForm1.Show
Unload UserForm1
End Sub
in Project Explorer (VBE) Right-click on the UserForm1 and hit View Code
Copy and paste the below code
Private Sub CommandButton1_Click()
With ListBox1
.AddItem TextBox1.Value
.List(.ListCount - 1, 1) = TextBox2.Value
End With
End Sub
Private Sub CommandButton2_Click()
Dim ws As Worksheet
' create a results sheets if you do not already have one
Set ws = Sheets("Results")
Dim nextAvailableRow As Long
Dim i As Long
For i = 0 To ListBox1.ListCount - 1
nextAvailableRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
ws.Range("A" & nextAvailableRow) = ListBox1.Column(0, i)
ws.Range("B" & nextAvailableRow) = ListBox1.Column(1, i)
Next i
Me.Hide
End Sub
Create a new spreadsheet and name it Results
Run the TestUserForm macro
Add sample data to the list and click Save button