I have three buttons in userform S1,S2,S3(sheet1,sheet2..) which assign a value specified in the textbox to the first cell on a sheet. How to do that after closing user form show sheet
into which the value was entered/last used sheet
Private Sub Zamknij_Click()
UserForm1.Hide
Worksheets("SheetName").Activate
End Sub
Private Sub Sheet1_Click()
Sheets(1).Cells(1, 1).Value = TextBox1.Value
End Sub
Private Sub Sheet2_Click()
Sheets(2).Cells(1, 1).Value = TextBox1.Value
End Sub
Private Sub Sheet3_Click()
Sheets(3).Cells(1, 1).Value = TextBox1.Value
End Sub
Putting my comments into code: Here is one possible way to implement what I think it is you're trying to do.
Private Sub Zamknij_Click()
Unload Me
End Sub
Private Sub Sheet1_Click()
ApplyToSheet Worksheets(1)
End Sub
Private Sub Sheet2_Click()
ApplyToSheet Worksheets(2)
End Sub
Private Sub Sheet3_Click()
ApplyToSheet Worksheets(3)
End Sub
Sub ApplyToSheet(wsSheet As Worksheet)
With wsSheet
.Activate
.Cells(1, 1) = TextBox1.Value
End With
End Sub
The above will show the target and then write TextBox1.
If you need to keep another or the current sheet visible until Zamknij is clicked, here is another approach:
Option Explicit
'At the top of the userform (before any subs): Declare a module-level variable
Private mwsTarget As Worksheet
Private Sub Zamknij_Click()
mwsTarget.Activate
Unload Me
End Sub
Private Sub Sheet1_Click()
ApplyToSheet Worksheets(1)
End Sub
Private Sub Sheet2_Click()
ApplyToSheet Worksheets(2)
End Sub
Private Sub Sheet3_Click()
ApplyToSheet Worksheets(3)
End Sub
Sub ApplyToSheet(wsSheet As Worksheet)
Set mwsTarget = wsSheet
wsSheet.Cells(1, 1) = TextBox1.Value
End Sub
Related
I made a workbook that has a userform thar is used to fill information in a new row, the information in the textboxes should be prefilled by using the information on the row below. This has to be repeated as many times as an input box value.
So far so good, but now I also need the users to be able to view other sheets in the same workbook where the required information is stored while the userform is open.
if I show the userform modeless I can view other sheets but then the code just keeps going and the second time the userform should pop up it doesn't.
I found a solution to that: using DoEvent.
but now the information is not (pre)filled correctly
Private Sub CommandButton2_Click()
Dim myValue As String
myValue = InputBox("How many do you have?")
If StrPtr(myValue) = 0 Then Exit Sub
For i = 1 To myValue
Range("A4").EntireRow.Insert
UserForm1.Show vbModeless
Do While UserForm1.Visible
DoEvents
Loop
Next
End Sub
What happens now is that the information from a row below is used regardless of any changes made by the user.
Does anyone have a solution?
Edit:
I don't think it is immediately required to understand my question but it might help a bit..
The rest of the code from the userform is as follows
Private Sub CommandButton1_Click()
Unload UserForm1
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
Cancel = True
Range("A4").EntireRow.delete
End
End If
End Sub
Private Sub TextBox1_Change()
Dim myValue As Variant
myValue = TextBox1
Range("A4").Value = myValue
End Sub
Private Sub UserForm_Initialize()
Me.TextBox1.Value = Format(Range("A2"), "dd/mm/yyyy")
Me.TextBox2.Value = Range("B5").Value
Me.TextBox3.Value = Range("C5").Value
Me.TextBox4.Value = Range("D5").Value
Me.TextBox5.Value = Range("E5").Value
Me.TextBox6.Value = Range("F5").Value
Me.TextBox7.Value = Range("G5").Value
Me.TextBox8.Value = Range("H5").Value
Me.TextBox9.Value = Range("J5").Value
Me.TextBox10.Value = Range("K5").Value
End Sub
Private Sub TextBox10_Change()
Dim myValue As Variant
myValue = TextBox10
Range("K4").Value = myValue
End Sub
Private Sub TextBox11_Change()
End Sub
Private Sub TextBox2_Change()
Dim myValue As Variant
myValue = TextBox2
Range("B4").Value = myValue
End Sub
Private Sub TextBox3_Change()
Dim myValue As Variant
myValue = TextBox3
Range("C4").Value = myValue
End Sub
Private Sub TextBox4_Change()
Dim myValue As Variant
myValue = TextBox4
Range("D4").Value = myValue
End Sub
Private Sub TextBox5_Change()
Dim myValue As Variant
myValue = TextBox5
Range("E4").Value = myValue
End Sub
Private Sub TextBox6_Change()
Dim myValue As Variant
myValue = TextBox6
Range("F4").Value = myValue
End Sub
Private Sub TextBox7_Change()
Dim myValue As Variant
myValue = TextBox7
Range("G4").Value = myValue
End Sub
Private Sub TextBox8_Change()
Dim myValue As Variant
myValue = TextBox8
Range("H4").Value = myValue
End Sub
Private Sub TextBox9_Change()
Dim myValue As Variant
myValue = TextBox9
Range("J4").Value = myValue
End Sub
~~
I figured that it indeed had to do with the fact that your initial code did not retrigger the TextBox#_Change subs as intended. I did it a little differently, and triggered them in CommandButton2_Click. This way, you don't need to reload really. But whatever works; just sharing for comparison. So, I am assuming a UserForm like this:
We will move row 4 down on Confirm Input. On Cancel, we'll clear it and exit. And on Confirm Input, the user will (continuously) be asked whether he wants to submit another entry. If not, we'll clear row 4 and exit as well.
So, I've rewritten these parts:
Private Sub CommandButton1_Click()
Range("A4").EntireRow.ClearContents
Unload UserForm1
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
Cancel = True
Range("A4").EntireRow.ClearContents
Range("A4").Resize(1, 11).Interior.Color = vbYellow
End
End If
End Sub
Private Sub CommandButton2_Click()
Range("A4").Resize(1, 11).Interior.Color = vbWhite
Range("A4").Resize(1, 11).Insert
Range("A4").Resize(1, 11).Interior.Color = vbYellow
For i = 1 To 10
myValue = Me.Controls("TextBox" & i).Value
Me.Controls("TextBox" & i).Value = ""
Me.Controls("TextBox" & i).Value = myValue
Next i
answer = MsgBox("Do you wish to add another row?", vbYesNo)
If answer = vbYes Then
Else
Range("A4").EntireRow.ClearContents
Unload UserForm1
End If
End Sub
Private Sub TextBox1_Change()
Dim myValue As Variant
myValue = TextBox1
If myValue = "" Then
Range("A4").Value = myValue
Else
Range("A4").Value = CDate(myValue)
End If
End Sub
You might want to get rid of the color (re)setting bits. But it may be good to realize that the practice of inserting rows all the time may have unintended effects for formatting. Suppose, for whatever reason, you want row 6 to have a red background. As is, the code will keep pushing this formatting one row down each time. This may be what you want, of course... Other than that, the "update" for TextBox1_Change makes sure you export an actual Excel Date, not a string.
Final warning (since we're using vbModeless): be aware that (both in your code and mine) there is no reference to the worksheet. Suppose your user goes into another sheet and clicks Confirm Input there, this will trigger Range("A4").Resize(1, 11).Insert inside the wrong sheet! Seems highly advisable to fix this.
I found a way..
I now changed the sub names of the textbox#_change subs and call them all on "userform unload".
Private Sub CommandButton1_Click() ' this is the command button on the userform
Call TX1
Unload UserForm1
End Sub
I created a macro for Excel which opens a list of all visible sheets in a workbook and goes to the desired sheet as you scroll through the list. The idea is to avoid using the mouse as much as possible.
I am forced to scroll down starting from the first item in the list.
I would like to instead "start" from the initial sheet (wherever it may be) so I can scroll up/down depending on what sheet I would like to open.
In other words,
I would like the listbox to populate with all visible sheets
I would like the starting point for the user to be the active sheet so they can scroll up/down from their starting point
Code for the listbox:
Private Sub CommandButton1_Click()
Unload ListBox
End Sub
Private Sub UserForm_Initialize()
Dim WS As Worksheet
For Each WS In Worksheets
ListBox1.AddItem WS.Name
Next WS
End Sub
Private Sub ListBox1_Click()
Sheets(ListBox1.Value).Activate
End Sub
Code which opens the listbox:
Public Sub ShowUserForm()
Load ListBox
ListBox.Show
Debug.Print "===="
Debug.Print
End Sub
another one...
Private Sub UserForm_Initialize()
Dim ws As Worksheet, idx As Long
With Me.ListBox1
For Each ws In ActiveWorkbook.Worksheets
If ws.Visible = xlSheetVisible Then
.AddItem ws.Name
If ws Is ActiveSheet Then
idx = .ListCount - 1 ' item indexes start at zero
End If
End If
Next
.ListIndex = idx '
End With
End Sub
Private Sub ListBox1_Change()
Worksheets(ListBox1.Value).Activate
End Sub
You mentioned "all . . . sheets", if you want to include Chart sheets loop Each objSheet in Sheets and in the change event replace Worksheets with Sheets
what's about that:
Private Sub UserForm_Initialize()
Dim wksTab As Worksheet
For Each wksTab In ThisWorkbook.Worksheets
If wksTab.Visible = xlSheetVisible Then
If wksTab.Name <> ActiveSheet.Name Then
Me.ListBox1.AddItem wksTab.Name
End If
End If
Next wksTab
Me.ListBox1.AddItem ActiveSheet.Name
Me.ListBox1.ListIndex = Me.ListBox1.ListCount - 1
End Sub
Best regards
Bernd
I need to write a code in VBA and use a userform to show multiple images of the same item and rank them which one would be the best. I need the number, 1 being the best one to 3 being the last pick to be stored in a cell next to the image. I will put screenshots of my data as well as the userform I made. Below is the code I wrote but somehow not showing any images at all.
Thank you.
Dim ImageName As String
Dim CopyImage As String
Private Sub CheckBox1_Click()
End Sub
Private Sub CheckBox2_Click()
End Sub
Private Sub CheckBox3_Click()
End Sub
Private Sub CheckBox4_Click()
End Sub
Private Sub CheckBox5_Click()
End Sub
Private Sub CheckBox6_Click()
End Sub
Private Sub CheckBox7_Click()
End Sub
Private Sub CheckBox8_Click()
End Sub
Private Sub cmdNext_Click()
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value = "" Then
MsgBox "Last Row"
ActiveCell.Offset(-1, 0).Select
Exit Sub
Else
Call GetImage
End If
End Sub
Private Sub cmdSave_Click()
ActiveCell.Offset(6349, 11).Select
If ActiveCell.Value = "" Then
MsgBox "Saved"
ActiveCell.Offset(6349, 11).Select
Exit Sub
Else
Call GetImage
End If
End Sub
Private Sub cmdLoad_Click()
If ActiveCell.Column <> 1 Or ActiveCell.Row = 1 Or ActiveCell.Value = "" Then
Cells(6349, 10).Select
End If
Call GetImage
cmdBack.Enabled = True
cmdNext.Enabled = True
End Sub
Private Sub cmdBack_Click()
ActiveCell.Offset(-1, 0).Select
If ActiveCell.Value = "" Then
MsgBox "Last Row"
ActiveCell.Offset(1, 0).Select
Exit Sub
Else
Call GetImage
End If
End Sub
Private Sub RankButton_Click()
End Sub
Private Sub DeleteButton_Click()
End Sub
Private Sub ClearButton_Click()
End Sub
Private Sub Image1_Click()
End Sub
Private Sub Image2_Click()
End Sub
Private Sub Image3_Click()
End Sub
Private Sub Image4_Click()
End Sub
Private Sub Image5_Click()
End Sub
Private Sub Image6_Click()
End Sub
Private Sub Image7_Click()
End Sub
Private Sub Image8_Click()
End Sub
Private Sub UserForm_Initialize()
cmdBack.Enabled = False
cmdNext.Enabled = False
'cmdSave.Enabled = False
End Sub
Private Sub GetImage()
Dim PhotoNames As String, fPath As String, iFile As String
Dim i As Integer
fPath = "D:\transfer\2021-12-13_image_ranking\dayco\2021-11-15_merged_dayco\"
Dim CurrentPartNumber As String
Dim CurrentImageIndex As Integer
CurrentImageIndex = 1
CurrentPartNumber = ActiveCell.Value
Sheets("IMAGE").Select
Dim CurrentCellValue As String
Dim CurrentRow As Long
CurrentRow = 6349
CurrentCellValue = Cells(CurrentRow, 10)
While Not (CurrentCellValue = "")
If CurrentCellValue = CurrentPartNumber Then
If Not Dir(fPath & Cells(CurrentRow, 10).Value) = "" Then
Me.Controls("Image" & CurrentImageIndex).Picture = LoadPicture(fPath & Cells(CurrentRow, 10).Value)
CurrentImageIndex = CurrentImageIndex + 1
End If
End If
CurrentRow = CurrentRow + 1
CurrentCellValue = Cells(CurrentRow, 1)
Wend
End Sub
I am trying to pass row number to UserForm, so it could display data in user friendly way for end user, but having trouble catching this variable on Initialize moment.
Code in the Worksheet module, it should open UserForm and pass row number as variable:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim DataRange As ListObject
Dim xRow As Long
xRow = Target.Row
Set DataRange = Sheets("Forecast").ListObjects("ForecastTable")
If Application.Intersect(Target, DataRange.DataBodyRange) Is Nothing Or Target.Cells.Count > 1 Then
Exit Sub
Else
MsgBox xRow
With FullInfo
.MyProp = xRow
.Show
End With
End If
End Sub
This is the code in UserForm:
Property Let MyProp(xRow As Long)
publicRow = xRow
End Property
Private Sub UserForm_Initialize()
Dim publicRow As Long
MsgBox publicRow
End Sub
From MsgBox I used for testing I determined that code in the sheet module returns correct row number, but then UserForm is initialized it shows 0 as no data is received. Interestingly enough, I put a button in the user form for testing with following code:
Private Sub Save_Click()
MsgBox publicRow
End Sub
After pressing it - it shows correct row number, so it means it passed but only after Initialize event. How should I pass variable to UserForm so it would be available at Initialize event?
I have a solution for you. :)
...so this is your code corrected ...
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim DataRange As ListObject
Dim xRow As Integer
Dim FullInfo As Object
xRow = Target.Row
Set DataRange = Sheets("Forecast").ListObjects("Tabela1")
If Application.Intersect(Target, DataRange.DataBodyRange) Is Nothing Or
Target.Cells.Count > 1 Then
Exit Sub
Else
Set FullInfo = New UserForm1
With FullInfo
.Label1.Caption = xRow
.Show
End With
End If
End Sub
... if you want to go further, I have another way to pass a public variable to userForm
You code in sheet
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim DataRange2 As ListObject
Dim xRow As Integer
xRow = Target.Row
Set DataRange2 = Sheets("Arkusz1").ListObjects("Tabela2")
If Application.Intersect(Target, DataRange2.DataBodyRange) Is Nothing Or
Target.Cells.Count > 1 Then
Exit Sub
Else
Call UserFormStart(xRow)
End If
End Sub
Put code to new module (in the worksheet do not work)
'Public rowSelection As Integer 'declare public variable
Public Sub UserFormStart(ByVal rowRef As Integer)
rowSelection = rowRef
UserForm1.Show
End Sub
In your userForm
Private Sub CommandButton1_Click()
MsgBox rowSelection & " it's work"
End Sub
Public Sub UserForm_Initialize()
MsgBox rowSelection
End Sub
It works for me :)
You can check one topic
Excel - VBA : pass variable from Sub to Userform
create combo box that only shows certain sheet instead of all available sheets,plus the ability to click on the sheet even when hidden?
am using forms controls comboBox, In Payment Code
Private Sub cbSheet_Change()
If cbSheet.Value <> "Select a Sheet" Then
Worksheets(cbSheet.Value).Select
End If
cbSheet.Value = "Select a Sheet"
End Sub
Private Sub Worksheet_Activate()
Dim Sh As Worksheet
Me.cbSheet.Clear
For Each Sh In ThisWorkbook.Worksheets
Me.cbSheet.AddItem Sh.Name
Next Sh
End Sub
In ThisWorkBook code
Private Sub Workbook_Open()
If ActiveSheet.Name = "Master Data" Then
Worksheets("Report").Select
Worksheets("Master Data").Select
End If
End Sub
When looping through the sheets, you can make sure not to add the sheet you don't want in the combobox
Private Sub ComboBox1_Change()
Dim sh As Worksheet, s As String
s = Me.ComboBox1
If s = "" Then Exit Sub
Set sh = Sheets(s)
With sh
If .Visible = False Then
.Visible = True
End If
.Select
End With
End Sub
Private Sub Worksheet_Activate()
Dim sh As Worksheet
Application.EnableEvents = False
Me.ComboBox1.Clear
For Each sh In Sheets
If sh.Name <> "Sheet1" Then
Me.ComboBox1.AddItem sh.Name
End If
Next sh
Application.EnableEvents = True
End Sub
The code should add the hidden sheet names
Adding specific sheets the the combbox
Private Sub Worksheet_Activate()
Application.EnableEvents = False
Me.ComboBox1.Clear
With Me.ComboBox1
.AddItem "Sheet2"
.AddItem "Sheet4"
.AddItem "Sheet5"
.AddItem "Sheet6"
End With
Application.EnableEvents = True
End Sub