So I have a form called "Print_Form" that has 20 checkboxes that upon form initialization take on the sheet names of the first 20 sheets of my workbook.
(no issue with the UserForm_Initialize() sub, this works fine)
Private Sub UserForm_Initialize()
CheckBox1.Caption = Sheets(1).Name
CheckBox2.Caption = Sheets(2).Name
CheckBox3.Caption = Sheets(3).Name
CheckBox4.Caption = Sheets(4).Name
CheckBox5.Caption = Sheets(5).Name
CheckBox6.Caption = Sheets(6).Name
CheckBox7.Caption = Sheets(7).Name
CheckBox8.Caption = Sheets(8).Name
CheckBox9.Caption = Sheets(9).Name
CheckBox10.Caption = Sheets(10).Name
CheckBox11.Caption = Sheets(11).Name
CheckBox12.Caption = Sheets(12).Name
CheckBox13.Caption = Sheets(13).Name
CheckBox14.Caption = Sheets(14).Name
CheckBox15.Caption = Sheets(15).Name
CheckBox16.Caption = Sheets(16).Name
CheckBox17.Caption = Sheets(17).Name
CheckBox18.Caption = Sheets(18).Name
CheckBox19.Caption = Sheets(19).Name
CheckBox20.Caption = Sheets(20).Name
End Sub
Where I am running into issues is in the following sub routine when the user clicks the print button in the form. The intention behind this button is to print all the sheets that the user has selected (i.e. the sheets that had their corresponding checkbox checked by the user). Currently, when I select multiple checkboxes and then click on the print button I get the following error; "Run-Time error '9': Subscript out of range.
Private Sub cmdPrint_Click()
Dim i As Integer
Dim cb As MSForms.Control
Dim SheetArray() As String
i = 0
'Search form for a checkbox
For Each cb In Me.Controls
i = i + 1
ReDim Preserve SheetArray(i)
'If the control is a checkbox
If TypeName(cb) = "CheckBox" Then
'and the checkbox is checked
If cb.Value = True Then
'Add the sheet to the sheet array (sheet name string was already added to the checkbox property caption; see UserForm_initialize)
SheetArray(i) = cb.Caption
End If
End If
Next cb
'Print Sheet Array
Sheets(SheetArray()).PrintOut
Unload Me
End Sub
If anyone has any ideas that would help me get this to work I would be very appreciative. Thank you in advance. :)
Try this:
Private Sub UserForm_Initialize()
Dim i As Long
For i = 1 To 20 'less typing....
Me.Controls("CheckBox" & i).Caption = Sheets(i).Name
Next i
End Sub
Private Sub cmdPrint_Click()
Dim i As Integer, s As String, sep
For i = 1 To 20
With Me.Controls("CheckBox" & i)
If .Value Then
s = s & sep & .Caption
sep = "," 'add delimiter after first item
End If
End With
Next i
Sheets(Split(s, ",")).PrintOut
Unload Me
End Sub
I have an excel sheet which contains two columns ( the column A contains Names and the column B contains Number Phones ).
I have created a comboBox with the list of names and I want to select a name from this comboBox and then update its corresponding phone number. I tried this code but it does not work.
Sub UpdateNumber()
Dim Ans As String, Index As Integer
Ans = InputBox("What is " & NameForm.ComboBox1.Value & " 's new phone number?")
If Ans <> "" Then
Index = NameForm.ComboBox1.ListIndex
Sheets("Names").Range("A" & Index).Offset(0, 1).Value = Ans
End If
End Sub
Could someone help me, please ?
try below code
Sub UpdateNumber(Optional boxShow As Boolean = True)
Dim Ans As String, Index As Integer
If boxShow = false Then exit sub
Ans = InputBox("What is " & NameForm.ComboBox1.Value & " 's new phone number?")
If Ans <> "" Then
Index = NameForm.ComboBox1.ListIndex
Sheets("Names").Range("A" & Index).Offset(0, 1).Value = Ans
End If
End Sub
sub btn_onclick()
boxShow True 'no msgbox
boxShow False 'with msgbox
boxShow 'no msgbx
end sub
found there
Excel VB newbie. I know I must be missing something very simple. How do I get before_save event to work with more than one worksheet? Only one needs code. I have it in ThisWorkbook. It works if I only have one sheet in my workbook.
After seeing the comment that it doesn't matter if there's more than one worksheet I looked again at my code. I fixed the code and now the BeforeSave event will trigger and not save until all conditions are met like it's supposed to.
The BeforeSave event triggers if I put it in ThisWorkbook. But if I put it in Sheet1 and call the sub in ThisWorkbook, it still runs the sub like it's supposed to but doesn't prevent it from saving. Hoping this makes sense. I know the code is messy so please bear with me.
Sheet1:
Sub checkSheet1()
Dim cellCount As Variant, findEmpty As String, Counter%
allYellowCellsArray = Array(Range("C6"), Range("C7"), Range("C8"), Range("C9"), Range("C18"), Range("C19"), Range("C20"), Range("C21"), Range("C22"), Range("C29"), Range("C30"), Range("C31"), Range("C32"), Range("C33"), Range("C42"), Range("C62"))
noDateYellowCellsArray = Array(Range("C6"), Range("C7"), Range("C8"), Range("C9"), Range("C18"), Range("C19"), Range("C20"), Range("C21"), Range("C22"), Range("C29"), Range("C30"), Range("C31"), Range("C32"), Range("C33"), Range("C42"))
emptyCell = ""
Counter = 0
Debug.Print vbNewLine & "List the values of each cell in the array:"
'count number of yellow/empty cells
For Each cellCount In allYellowCellsArray
Debug.Print cellCount.Address() & " value is " & cellCount & " and color is " & cellCount.DisplayFormat.Interior.Color
If cellCount = emptyCell Then
Counter = Counter + 1
End If
Next
'If-Then statements to alert how many yellow cells are still empty.
If Counter >= 1 Then
MsgBox "(" & Counter & ") Mandatory Cells Have Not Been Completed", vbExclamation, "Missing Information"
'cellCount = "Enter Missing Information"
End If
For Each cellCount In noDateYellowCellsArray
If cellCount.Value = "" Then
cellCount.Value = "Enter Missing Information"
End If
Next
'Evaluate all yellow cells to prevent empty cells and make sure the set values have been changed ----
Dim cellValue As Variant
Dim fieldsAreYellow As Boolean
fieldsAreYellow = True
Dim redCellColor As Boolean
redCellColor = True
Dim cellCellColor As Variant
Debug.Print vbNewLine & "List cells that are red:"
For Each cellCellColor In allYellowCellsArray 'check for red cells
If cellCellColor.DisplayFormat.Interior.Color = 255 Then 'if cell background color is red
redCellColor = True
Debug.Print cellCellColor.Address() & " is " & cellCellColor.DisplayFormat.Interior.Color
Cancel = True
End If
If redCellColor = False Then
MsgBox "There are no more red cells."
Cancel = True
End If
Next cellCellColor
Dim cellCountRedCells As Variant, redCellCounter%
redCellCounter = 0
For Each cellCountRedCells In allYellowCellsArray
If cellCountRedCells.DisplayFormat.Interior.Color = 255 Then 'red
redCellCounter = redCellCounter + 1
Debug.Print "redCellCounter is " & redCellCounter
'MsgBox "redCellCounter is " & redCellCounter
End If
Next
Debug.Print "redCellCounter is " & redCellCounter
'Check to see if cells in array have been changed
Debug.Print vbNewLine & "List the current background color of the first non-numeric cell that stopped the loop:"
For Each cellValue In allYellowCellsArray
If cellValue = "Enter Missing Information" Then
Debug.Print vbNewLine & cellValue
fieldsAreYellow = False
Debug.Print cellValue.Address() & " color is " & cellValue.DisplayFormat.Interior.Color
MsgBox "Check all of your cells for correct information." & vbNewLine & "There are still (" & redCellCounter & ") red cells.", vbCritical, "SAVE CANCELLED"
Cancel = True ' ** prevent the file from being saved **
Exit For
End If
Next cellValue
'Final check
If (fieldsAreYellow = True) And (redCellCounter = 0) Then
MsgBox "The document will be saved." & vbNewLine & "Remember the naming convention." & vbNewLine & "Customer_PIP Seal Calculator_Part Number rev#_Part Name_DDMMYY", vbInformation, "Good to Go!"
Cancel = False 'allow save
Else:
MsgBox "This file will not save until all of the cells have correct information.", vbCritical, "SAVE CANCELLED"
Cancel = True 'cancel save
End If
End Sub
ThisWorkbook:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Call Sheet1.checkSheet1
End Sub
I created a new excel file and tested this event. It works perfectly on both sheets.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
MsgBox "OK"
End Sub
I suggest to try this on a new file and then copy your code to the new file.
In order to make the event was as you need, the called Sub must be transformed in a Function returning Boolean.
The event code should look like this:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = Sheet1.checkSheet1
End Sub
And the called function, like this:
Public Function checkSheet1() As Boolean
If 1 = 1 Then
MsgBox "The saving cannot take place..."
checkSheet1 = True 'instead of Cancel = True in the Sub
Else
checkSheet1 = False
End If
End Function
You must adapt your code to finally return something like checkSheet1 = Cancel. But take care to properly declare Dim Cancel as Boolean...
If something unclear, please, do not hesitate to ask for clarifications. If you need me to transform your existing Sub, I can do it, but I think it is better for you do do that, in order to understand the meaning and learn...
Loop Through Worksheets In BeforeSave
Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
' Create a list of worksheet names.
Const wsList As String = "Sheet1,Sheet2,Sheet3"
Dim nms() As String ' Declare an array of type 'String'.
nms = Split(wsList, ",") ' Write the list to the array.
Dim ws As Worksheet ' Declare a worksheet variable.
Dim n As Long ' Declare a 'counter' variable of type 'Long'.
' Loop through the elements (names) in the array.
For n = 0 To UBound(nms)
' Define current worksheet.
Set ws = ThisWorkbook.Worksheets(nms(n))
' Do something, e.g. write some text to cell 'A1' and autofit column 'A'.
ws.Range("A1").Value = "Testing worksheet '" & ws.Name & "'."
ws.Columns("A").AutoFit
Next n
End Sub
I have a PowerApp which updates a cell in an Excel file hosted in OneDrive. The Excel file contains a macro that is supposed to run when the PowerApp changes the Excel file. However, it doesn't do that. If I update a cell manually, the macro works just fine. It's just not activated when the file is updated by PowerApps.
Is there a different function I can use that will be triggered when PowerApp changes the file?
If that is not possible, could I use a Flow to activate the macro?
Here is the current script that works with manual changes, but not the automatic PowerApps changes.
Private Sub Worksheet_Change(ByVal Target As Range)
Call InsertImageTest
End Sub
Here is the macro that I want to trigger using the code above.
Sub InsertImageTest()
' This macro inserts an image from a set location to a set cell.
Dim ws As Worksheet
Dim imagePath As String
Dim cell As String
Dim posText As String
Dim imgLeft As Double
Dim imgTop As Double
Dim rngX As Range
Dim activeSheetName As String
' Customizable variables
imagePath = ActiveWorkbook.Path & Range("$B$2").Value
posText = "Signature"
activeSheetName = "Data" ' Set to "Data" by default, but will change to the Active sheets name, if the active sheet is not called "Data"
' For i = 1 To Sheets.Count
' If CStr(Sheets(i).Name) Is CStr(activeSheetName) Then
' Debug.Print "Code can be executed! Data tab was found"
' End If
' Next i
cell = "$A$1"
Set ws = ActiveSheet
Set rngX = Worksheets(activeSheetName).Range("A1:Z1000").Find(posText, lookat:=xlPart)
If Not rngX Is Nothing Then
cell = rngX.Address
Debug.Print cell
Debug.Print rngX.Address & " cheating"
Worksheets(activeSheetName).Range(cell).Value = ""
Debug.Print rngX.Address & " real"
imgLeft = Range(cell).Left
imgTop = Range(cell).Top
' Width & Height = -1 means keep original size
ws.Shapes.AddPicture _
Filename:=imagePath, _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, _
Left:=imgLeft, _
Top:=imgTop, _
Width:=-1, _
Height:=-1
End If
' The code beaneath will resize the cell to fit the picture
For Each Picture In ActiveSheet.DrawingObjects
PictureTop = Picture.Top
PictureLeft = Picture.Left
PictureHeight = Picture.Height
PictureWidth = Picture.Width
For N = 2 To 256
If Columns(N).Left > PictureLeft Then
PictureColumn = N - 1
Exit For
End If
Next N
For N = 2 To 65536
If Rows(N).Top > PictureTop Then
PictureRow = N - 1
Exit For
End If
Next N
Rows(PictureRow).RowHeight = PictureHeight
Columns(PictureColumn).ColumnWidth = PictureWidth * (54.29 / 288)
Picture.Top = Cells(PictureRow, PictureColumn).Top
Picture.Left = Cells(PictureRow, PictureColumn).Left
Next Picture
End Sub
Unfortunately the server opens Excel through APIs and Excel doesn't fire macros in this way. It seems flow has the same. I would consider implement the macro function logic in PowerApps. Customize the edit form of the column which supposes to trigger the macro, depends what the macro should do. Possibly unlock a data card if the macro trys to alter a value of another column.
The following code makes me able to select only one cell (in this case A3), click on a button and bring a picture. The nagative thing is that i need it to work also on other cells (from A3 to A22) and i don't know how to modify the code in order to do so. Any suggestions? Thank you
Private Sub cmdDisplayPhoto_Click()
Application.ScreenUpdating = False
Dim myObj
Dim Pictur
Set myObj = ActiveSheet.DrawingObjects
For Each Pictur In myObj
If Left(Pictur.Name, 7) = "Picture" Then
Pictur.Select
Pictur.Delete
End If
Next
Dim Exercise As String, T As String
myDir = "C:\Users\Computer\Desktop\Pictures of Exercises\"
Exercise = Range("A3")
T = ".PNG"
ActiveSheet.Shapes.AddPicture Filename:=myDir & Exercise & T, linktofile:=msoFalse, savewithdocument:=msoTrue, Left:=770, Top:=60, Width:=160, Height:=150
Application.ScreenUpdating = True
End Sub
Try changing...
Exercise = Range("A3")
to
if ActiveCell.column = 1 then Exercise = ActiveCell Else Exit Sub
This will use the text of whatever cell is selected for the picture and only accept cells from column A.