I am trying to display an existing graph (Name: Chart 3) from Sheet3 to userform.
I used the below code, and it pops up error with debugging
Private Sub CommandButton1_Click()
Dim cchart As Chart
Dim fname As String
Set cchart = Sheets("Sheet3").ChartObjects("Chart 3").Chart
fname = "C:\CBS Academic\Integrated Strategy Project\Final
Paper\Temp\temp.gif"
cchart.Export Filename:=fname, filtername:="gif"
Image1.Picture = LoadPicture(fname)
End sub
Try this: (Tested)
Private Sub CommandButton1_Click()
Dim cchart As Chart
Dim fname As String
Set cchart = Sheets("Sheet3").ChartObjects("Chart 3").Chart
fname = "C:\CBS Academic\Integrated Strategy Project\FinalPaper\Temp\temp.gif" 'check the address again
cchart.Export Filename:=fname, filtername:="gif"
Image1.Picture = LoadPicture(fname)
End sub
Related
is there I way for searching a value on the next sheet (ActiveSheet.Next.Activate) without jumping on to it?
Here the whole Code:
the problem is, it jumps to the next sheet even if there is no searched value.
Dim ws As Worksheet
Dim Loc As Range
Dim StrVal As String
Dim StrRep As String
Dim i As Integer
Private Sub CommandButton1_Click()
i = 1
Call Replacing
End Sub
Private Sub CommandButton2_Click()
i = 2
Call Replacing
End Sub
Public Sub Replacing()
StrVal = Userform1.Textbox1.Text
StrRep = Me.Textbox1.Text
if Trim(StrVal) = "" Then Exit Sub
Dim fstAddress As String
Dim nxtAddress As String
For Each ws In ThisWorkbook.Worksheets
With ws
Set Loc = .Cells.Find(what:=StrVal)
fstAddress = Loc.Address
If Not Loc Is Nothing Then
If Not StrRep = "" And i = 1 Then
Loc.Value = StrRep
Set Loc = .Cells.FindNext(Loc)
ElseIf i = 2 Then Set Loc = Range(ActiveCell.Address)
Set Loc = .Cells.FindNext(Loc)
nxtAddress = Loc.Address
If Loc.Address = fstAddress Then
ActiveSheet.Next.Activate '****Here it should jump only if found something on the next sheet****
GoTo repeat
nxtAddress = Loc.Address
End If
If Not Loc Is Nothing Then Application.Goto ws.Range(nxtAddress), False
End If
i = 0
End If
End With
Set Loc = Nothing
repeat:
Next ws
End Sub
the variable "i" which switches between the values 0, 1 and 2 is bound to two buttons. these buttons are "Replace" and "Skip (to next found value)".
This code asks on each occurrence of StrVal whether you want to replace the value or skip it.
I found a problem checking if Found_Address = First_Found_Address:
If you've replaced the value in in First_Found_Address it won't find that address again and miss the starting point in the loop.
Also the original source of the code stops at the last value using Loop While Not c Is Nothing And c.Address <> firstAddress. The problem here is that if the value in c is being changed eventually c will be Nothing but it will still try and check the address of c - causing an error (Range Find Method).
My solution to this is to build up a string of visited addresses on the sheet and checking if the current address has already been visited using INSTR.
I've included the code for calling from a button click or from within another procedure.
Private Sub CommandButton1_Click()
FindReplace Userform1.Textbox1.Text, 1
End Sub
Private Sub CommandButton2_Click()
FindReplace Userform1.Textbox1.Text, 1, Me.Textbox1.Text
End Sub
Sub Test()
FindReplace "cd", 1, "ab"
End Sub
Sub FindReplace(StrVal As String, i As Long, Optional StrRep As String = "")
Dim ws As Worksheet
Dim Loc As Range
Dim fstAddress As String
Dim bDecision As Variant
For Each ws In ThisWorkbook.Worksheets
'Reset the visited address list on each sheet.
fstAddress = ""
With ws
Set Loc = .Cells.Find(what:=StrVal, LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)
If Not Loc Is Nothing Then
Do
fstAddress = fstAddress & "|" & Loc.Address
Loc.Parent.Activate 'Activate the correct sheet.
Loc.Activate 'and then the cell on the sheet.
bDecision = MsgBox("Replace value?", vbYesNo + vbQuestion, "Replace or Select value?")
If bDecision = vbYes Then
Loc = StrRep 'Raise the blade, make the change.
'Re-arrange it 'til it's sane.
End If
Set Loc = .Cells.FindNext(Loc)
If Loc Is Nothing Then Exit Do
Loop While InStr(fstAddress, Loc.Address) = 0
End If
End With
Next ws
End Sub
I am trying to display specific data in a specific worksheet using a user form.
There is one command button on the user form - Next - that takes the users preferences (option button chosen), opens a new workbook, and displays the desired data (check boxes chosen) in the specific workbook.
There are 6 option buttons and and 6 check boxes. The worksheet that opens is based on the option button preference and depending on what was chosen in the check boxes, the data associated to that topic will display in the worksheet.
How can i loop options buttons and check boxes on a userform and capture which are "selected"?
The data displayed (in a worksheet) from the chosen check boxes depends on the option button chosen e.g. if I chose Finance (option button), and then I chose Photos and Videos (check boxes), I'd like to display data specific to those selections on the appropriate worksheet.
Here is what I have so far:
Private Sub cmdNext_Click()
'declare variables
Dim strFinancial As String, strFamily As String, strSadness As String,
strSchool As String, strRelationship As String, strTime As String
Dim shtFinancial As Worksheet, shtFamily As Worksheet, shtSadness As
Worksheet, shtSchool As Worksheet, shtRelationship As Worksheet,
shtTime As Worksheet, shtData As Worksheet
shtFinancial = Workbooks("PROJECT.xlsm").Worksheets("Financial")
shtTime = Workbooks("PROJECT.xlsm").Worksheets("Time")
shtFamily = Workbooks("PROJECT.xlsm").Worksheets("Family")
shtSadness = Workbooks("PROJECT.xlsm").Worksheets("Sadness")
shtSchool = Workbooks("PROJECT.xlsm").Worksheets("School")
shtRelationship = Workbooks("PROJECT.xlsm").Worksheets("Relationship")
shtData = Workbooks("PROJECT.xlsm").Worksheets("Data")
'set option button selection to string
strFinancial = obFinancial.Value
strFamily = obFamily.Value
strSadness = obSadness.Value
strSchool = obSchool.Value
strRelationship = obRelationship.Value
strTime = obTime.Value
'activate worksheet of chosen stressor (option button)
Select Case True
Case strTime = True
shtTime.activate
Case strFinancial = True
shtFinancial.activate
Case strFamily = True
shtFamily.activate
Case strSadness = True
shtSadness.activate
Case strSchool = True
shtSchool.activate
Case strRelationship = True
shtRelationship.activate
End Select
'ADVICE
'loop through checkboxes HOW ????
'display advice according to option button chosen
If obFinancial.Value = True And Me.cbAdvice.Value = True Then
shtData.Range("A1:A10").Copy Destination:=Sheets("Financial").Range("A1:A10")
End If
If obSadness.Value = True And Me.cbAdvice.Value = True Then
Sheets("Data").Range("A21:A30").Copy Destination:=Sheets("Sadness").Range("A1:A10")
End If
If obSchool.Value = True And Me.cbAdvice.Value = True Then
Sheets("Data").Range("A31:A40").Copy Destination:=Sheets("School").Range("A1:A10")
End If
If obRelationship.Value = True And Me.cbAdvice.Value = True Then
Sheets("Data").Range("A41:A50").Copy Destination:=Sheets("Relationship").Range("A1:A10")
End If
If obTime.Value = True And Me.cbAdvice.Value = True Then
Sheets("Data").Range("A51:A60").Copy Destination:=Sheets("Time").Range("A1:A10")
End If
End Sub
Here is the userform:
Yes, it's little bit unclear what you trying to do...
Following is a general example how you might loop through CheckBoxes and OptionButtons:
Private Sub CommandButton1_Click()
Dim c As Control, str As String
For Each c In UserForm1.Controls
If TypeName(c) = "CheckBox" Or TypeName(c) = "OptionButton" Then
str = str & IIf(c = True, c.Caption & vbCrLf, "")
End If
Next c
MsgBox "Selected controls" & vbCrLf & str
End Sub
It is a little difficult to see exactly what you want but I can't help wondering if you're looking at VBA in the wrong way. VBA is an event-driven language, meaning that you can capture most interactions the user has with your programme. This should do away with the need to loop through your controls each time, as you could just log selections as the user makes them.
The most obvious thing to do would be to create some kind of sheet/range map, say in a Collection, and then just retrieve the objects you want based on a selection key. The code below is a skeleton of how you could do it - obviously you'd need to expand and adjust it to suit your own needs.
First declare a few variables at module-level (ie very top of your page):
Option Explicit
Private mRangeMap As Collection
Private mOptKey As String
Private mCboxKey As String
Then build your map. In the example below, I've done this in the Userform_Initialize routine, but you could call it anywhere:
Private Sub UserForm_Initialize()
Dim shtRngPair(1) As Object
'Build the range map.
Set mRangeMap = New Collection
With ThisWorkbook 'use name ofyour workbook
Set shtRngPair(0) = .Worksheets("Financial")
With .Worksheets("Data")
Set shtRngPair(1) = .Range("A1:A10")
mRangeMap.Add shtRngPair, "Fin|Adv"
Set shtRngPair(1) = .Range("A11:A20")
mRangeMap.Add shtRngPair, "Fin|Pho"
End With
Set shtRngPair(0) = .Worksheets("Sadness")
With .Worksheets("Data")
Set shtRngPair(1) = .Range("A21:A30")
mRangeMap.Add shtRngPair, "Sad|Adv"
Set shtRngPair(1) = .Range("A31:A40")
mRangeMap.Add shtRngPair, "Sad|Pho"
End With
Set shtRngPair(0) = .Worksheets("School")
With .Worksheets("Data")
Set shtRngPair(1) = .Range("A41:A50")
mRangeMap.Add shtRngPair, "Sch|Adv"
Set shtRngPair(1) = .Range("A51:A60")
mRangeMap.Add shtRngPair, "Sch|Pho"
End With
End With
End Sub
Now you just need the code to store the user inputs. I just have 3 option buttons and 2 checkboxes for an example:
Private Sub cboxAdvice_Click()
mCboxKey = "Adv"
End Sub
Private Sub cboxPhotos_Click()
mCboxKey = "Pho"
End Sub
Private Sub obFinancial_Click()
mOptKey = "Fin"
End Sub
Private Sub obSadness_Click()
mOptKey = "Sad"
End Sub
Private Sub obSchool_Click()
mOptKey = "Sch"
End Sub
Finally, copy the data when the user hits the Next button:
Private Sub cmdNext_Click()
Dim key As String
Dim shtRngPair As Variant
Dim v As Variant
'Create the key
key = mOptKey & "|" & mCboxKey
'Find the relevant range
On Error Resume Next
shtRngPair = mRangeMap(key)
On Error GoTo 0
'Test if the key is valid
If IsEmpty(shtRngPair) Then
MsgBox "Selection [" & key & "] is invalid."
Exit Sub
End If
'Copy the data
v = shtRngPair(1).Value2
With shtRngPair(0)
.Cells.Clear
.Range("A1").Resize(UBound(v, 1), UBound(v, 2)).Value = v
.Activate
End With
End Sub
Update as per OP's comment
Below is the updated code which iterates your checkbox selections. You'd need to add additional code if you wanted them in a specific order:
Option Explicit
Private mRangeMap As Collection
Private mCboxKeys As Collection
Private mOptKey As String
Private Sub cboxAdvice_Change()
UpdateCheckboxList "Adv", cboxAdvice.Value
End Sub
Private Sub cboxPhotos_Change()
UpdateCheckboxList "Pho", cboxPhotos.Value
End Sub
Private Sub UpdateCheckboxList(ele As String, addItem As Boolean)
'Add or remove the item
If addItem Then
mCboxKeys.Add ele, ele
Else
mCboxKeys.Remove ele
End If
End Sub
Private Sub obFinancial_Click()
mOptKey = "Fin"
End Sub
Private Sub obSadness_Click()
mOptKey = "Sad"
End Sub
Private Sub obSchool_Click()
mOptKey = "Sch"
End Sub
Private Sub cmdNext_Click()
Dim key As String
Dim shtRngPair As Variant, v As Variant, cbk As Variant
Dim rng As Range
Dim initialised As Boolean
For Each cbk In mCboxKeys
'Create the key
key = mOptKey & "|" & cbk
'Find the relevant range
On Error Resume Next
shtRngPair = mRangeMap(key)
On Error GoTo 0
If IsEmpty(shtRngPair) Then
'Test if the key is valid
MsgBox "Selection [" & key & "] is invalid."
Else
If Not initialised Then
With shtRngPair(0)
.Cells.Clear
.Activate
Set rng = .Range("A1")
End With
initialised = True
End If
'Copy the data
v = shtRngPair(1).Value2
rng.Resize(UBound(v, 1), UBound(v, 2)).Value = v
'Offset range
Set rng = rng.Offset(UBound(v, 1))
End If
Next
End Sub
Private Sub UserForm_Initialize()
Dim shtRngPair(1) As Object
'Initialise the collections
Set mRangeMap = New Collection
Set mCboxKeys = New Collection
'Build the range map.
With ThisWorkbook 'use name ofyour workbook
Set shtRngPair(0) = .Worksheets("Financial")
With .Worksheets("Data")
Set shtRngPair(1) = .Range("A1:A10")
mRangeMap.Add shtRngPair, "Fin|Adv"
Set shtRngPair(1) = .Range("A11:A20")
mRangeMap.Add shtRngPair, "Fin|Pho"
End With
Set shtRngPair(0) = .Worksheets("Sadness")
With .Worksheets("Data")
Set shtRngPair(1) = .Range("A21:A30")
mRangeMap.Add shtRngPair, "Sad|Adv"
Set shtRngPair(1) = .Range("A31:A40")
mRangeMap.Add shtRngPair, "Sad|Pho"
End With
Set shtRngPair(0) = .Worksheets("School")
With .Worksheets("Data")
Set shtRngPair(1) = .Range("A41:A50")
mRangeMap.Add shtRngPair, "Sch|Adv"
Set shtRngPair(1) = .Range("A51:A60")
mRangeMap.Add shtRngPair, "Sch|Pho"
End With
End With
End Sub
I have a code that counts the files in a folder if they contain a specific string on their name.
For example: If I want it to count the files with close on their name (Close_26_03_2003.csv).
Currently the code reads the value of a cell in the sheet and searches for that string in the file name with the (InStr function). Problem is I have to write the type of file in the cell.
What I am trying to do is create an user form, with three option buttons (open, close and cancel). For open it sets the string equal to open, and search for files that have it on their name (same as for close). Cancel ends the sub.
Problem is I don't know which code I have to use in the user form for this and don't know how to pass it to the code that counts files (I though about assigning it to a variable).
Code as is:
Sub CountFiles3()
Dim path As String, count As Integer, i As Long, var As Integer
Dim ws As Worksheet
Dim Filename As String
Dim FileTypeUserForm As UserForm1
Application.Calculation = xlCalculationManual
path = ThisWorkbook.path & "\*.*"
Filename = Dir(path)
'the problem is here:
'x = user form result***************
'if cancel = true, end sub
Set ws = ThisWorkbook.Sheets("FILES")
i = 0
Do While Filename <> ""
'var = InStr(Filename, ws.Cells(2, 7).Value) 'this is current code, it checks if the cell has open or close
var = InStr(Filename, x)
If var <> 0 Then
i = i + 1
ws.Cells(i + 1, 1) = Filename
Filename = Dir()
Else: Filename = Dir()
End If
Loop
Application.Calculation = xlCalculationAutomatic
ws.Cells(1, 2) = i
MsgBox i & " : files found in folder"
End Sub
And this is my current user form code:
Private Sub Cancel_Click()
Me.Tag = 3 ' EndProcess
Me.Hide
End Sub
Private Sub ClosingType_Click()
Me.Tag = 2 ' "CLOSING"
Me.Hide
End Sub
Private Sub OpeningType_Click()
Me.Tag = 1 ' "OPENING"
Me.Hide
End Sub
Any ideas?
add following code to your CountFiles3() sub in the "'the problem is here:" section:
Dim x As String
x = GetValue
If x = "end" Then Exit Sub
then add following code in any module:
Function GetValue()
With MyUserForm '<--| change "MyUserForm " to your actual UserForm name
.Show
GetValue = .Tag
End With
Unload MyUserForm '<--| change "MyUserForm " to your actual UserForm name
End Function
and change your Userform code as follwos
Private Sub Cancel_Click()
Me.Tag = "end" ' EndProcess
Me.Hide
End Sub
Private Sub ClosingType_Click()
Me.Tag = "close" ' "CLOSING"
Me.Hide
End Sub
Private Sub OpeningType_Click()
Me.Tag = "open" ' "OPENING"
Me.Hide
End Sub
I want when I click the button "Sélectionner un poste" it will tell me the position. (The button which I clicked in which row.)
Code to create the button:
Sub AjouterBoutonPoste(positionX As Integer, positionY As Integer, nom As String)
Set t = ActiveSheet.Range(Cells(positionX, positionY), Cells(positionX, positionY))
Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height)
With btn
.OnAction = "PosteBtAction"
.Caption = "Sélectionner un poste"
.Name = nom & CStr(positionX) & CStr(positionY)
End With
End Sub
Code for the event button:
Sub PosteBtAction()
AssocierSessoinCandidature.Show
End Sub
I have an application window named AssocierSessoinCandidature. I want the position which I clicked sent to the application window.
Here is my example Excel sheet:
Call the below Sub when the button is clicked
Sub foo()
Dim obj As Object
Dim row_no As Integer
Set obj = ActiveSheet.Buttons(Application.Caller)
With obj.TopLeftCell
row_no = .Row
End With
MsgBox "The Button is in the row number " & row_no
End Sub
You can access properties of the Button object for TopLeftCell and BottomRightCell to get the range addresses that bound the control:
Option Explicit
Sub Test()
Dim ws As Worksheet
Dim btn As Object
Dim strAddressTopLeft As String
Dim strAddressBottomRight As String
Dim strButtonName As String
Set ws = ActiveSheet
For Each btn In ws.Buttons
strAddressTopLeft = btn.TopLeftCell.Address
strAddressBottomRight = btn.BottomRightCell.Address
strButtonName = btn.Name
Debug.Print "Range of button (" & strButtonName & "): " & _
strAddressTopLeft & ":" & _
strAddressBottomRight
Next btn
End Sub
I have used something very similar, you can adapt the below code:
Sub Button24_Click()
Dim strShape As String
strShape = Shapes("button24").TopLeftCell.Address
CallAnotherFunction strShape
End Sub
Upon clicking the button, this code will take the range of button24 as a string (not sure why I didn't use a range, you could if you wish) and pass it to the function CallAnotherFunction
In summary, this is what you need:
Shapes("button24").TopLeftCell.Address
or
Shapes("button24").TopLeftCell.Row
I need some help with a vba code that will delete and entire row from a different sheet from the currently active one.
The code uses a userform to delete a row based upon a serial number entered into a text box. The rows to delete are duplicated on the sheet the userform is activated from as well as another. Below is an example I have tried which will delete the row of the current sheet but sends back an error for the second portion of code in the Else command.
Private Sub ScrapButton_Click()
Dim RTCNumber As String
RTCNumber = RTCTextBox
MSG1 = MsgBox("Remove " + RTCTextBox + " from Lab Stock?", vbYesNo)
If MSG1 = vbNo Then
Exit Sub
Else
Dim Row As Integer
Row = Application.WorksheetFunction.Match(RTCNumber, Sheet6.Range("A:A"), 0)
Rows(Row).EntireRow.Delete
Dim Row2 As Integer
Row2 = Application.WorksheetFunction.Match(RTCNumber, Sheet1.Range("A:A"), 0)
Sheets("Sheet1").Rows(Row2).EntireRow.Delete
End If
End Sub
Any help would be much appreciated, I am probably missing something obvious but I am fairly new to vba. I have tried several options and can't get it to work using a Worksheet.Activate function.
Thanks in advance.
James
Try to CLng the first argument of your match function. That works for me.
Had to remove WorksheetFunction on my version of Excel, but I don't know if that's the case on your machine, so I left it in.
And then, as manu stated in his answer, I added Sheet references.
Private Sub ScrapButton_Click()
Dim RTCNumber As String
RTCNumber = RTCTextBox
MSG1 = MsgBox("Remove " + RTCTextBox + " from Lab Stock?", vbYesNo)
If MSG1 = vbNo Then
Exit Sub
Else
Dim Row As Integer
Row = Application.WorksheetFunction.Match(Clng(RTCNumber), Sheets("Sheet6").Range("A:A"), 0)
Rows(Row).EntireRow.Delete
Dim Row2 As Integer
Row2 = Application.WorksheetFunction.Match(Clng(RTCNumber), Sheets("Sheets1").Range("A:A"), 0)
Sheets("Sheet1").Rows(Row2).EntireRow.Delete
End If
End Sub
Try this:
Private Sub ScrapButton_Click()
Dim RTCNumber As Double
Dim Row2 As Variant
Dim Row1 As Variant
Dim wb As Workbook
Dim ws1 As Worksheet
Dim ws6 As Worksheet
Set wb = ThisWorkbook
Set ws1 = wb.Sheets("Sheet1")
Set ws6 = wb.Sheets("Sheet6")
RTCNumber = RTCTextBox
MSG1 = MsgBox("Remove " & RTCNumber & " from Lab Stock?", vbYesNo)
If MSG1 = vbNo Then
Exit Sub
Else
Row1 = ws6.Application.WorksheetFunction.Match(RTCNumber, ws6.Range("A:A"), 0)
ws6.Rows(Row1).EntireRow.Delete
Row2 = ws1.Application.WorksheetFunction.Match(RTCNumber, ws1.Range("A:A"), 0)
ws1.Rows(Row2).EntireRow.Delete
End If
End Sub
Brilliant, thanks for the help!
Managed to get it working with Manu's answer with a couple tiny tweaks. It ended up like this:
Private Sub ScrapButton_Click()
Dim RTCNumber As String
Dim Row2 As Variant
Dim Row1 As Variant
Dim wb As Workbook
Dim ws1 As Worksheet
Dim ws6 As Worksheet
Set wb = ActiveWorkbook
Set ws1 = wb.Worksheets("Lab Stock")
Set ws6 = wb.Worksheets("Scrap")
RTCNumber = RTCTextBox
MSG1 = MsgBox("Remove " & RTCNumber & " from Lab Stock?", vbYesNo)
If MSG1 = vbNo Then
Exit Sub
Else
Row1 = ws6.Application.WorksheetFunction.Match(RTCNumber, ws6.Range("A:A"), 0)
ws6.Rows(Row1).EntireRow.Delete
Row2 = ws1.Application.WorksheetFunction.Match(RTCNumber, ws1.Range("A:A"), 0)
ws1.Rows(Row2).EntireRow.Delete
End If
End Sub
Much, much appreciated!
You can use more simple way to achieve required results using range.find method.
So, your code can looks like this:
Private Sub ScrapButton_Click()
Dim RTCNumber As String
Dim Cl As Range
RTCNumber = RTCTextBox
msg1 = MsgBox("Remove " + RTCTextBox + " from Lab Stock?", vbYesNo)
If msg1 = vbNo Then
Exit Sub
Else
With Sheets("Sheet1")
Set Cl = .[A:A].Find(RTCNumber, , xlValues, xlWhole)
If Not Cl Is Nothing Then Cl.EntireRow.Delete
End With
With Sheets("Sheet6")
Set Cl = .[A:A].Find(RTCNumber, , xlValues, xlWhole)
If Not Cl Is Nothing Then Cl.EntireRow.Delete
End With
End If
End Sub
If you still prefer usage of worksheetfunction then you shall know that if worksheetfunction.match couldn't find the search value then it will return error, worksheetfunctions shall be used only with error handling.