I am trying to make it so that if check box 82 is not checked then cell J39 is left blank but if it is checked the value is 3.8. On the line "Sheet.Range("J39").PasteSpecial Paste = "3.8"" I am getting a error message 1004
Sub ChckBx_Deisel_Engines()
Dim Sheet As Worksheet: Set Sheet = ThisWorkbook.Worksheets("NSR FORM")
If Sheet.Shapes("Check Box 82").ControlFormat.Value = 0 Then
Sheet.Range("J39").PasteSpecial Paste = ""
End
ElseIf Sheet.Shapes("Check Box 82").ControlFormat.Value = 1 Then
Sheet.Range("J39").PasteSpecial Paste = "3.8"
End If
End Sub
Any Ideas on how to perform this function in a better way would also begreatly appreciated
Figured it out! Here is the code I changed it to to get this function to work
Sub Button82_Click()
If ThisWorkbook.Worksheets("NSR FORM").Shapes("Check Box 82").OLEFormat.Object.Value = 1 Then
Range("J39").Value = "3.8"
Else
Range("J39").Value = ""
End If
End Sub
Dim Sheet As Worksheet: Set Sheet = ThisWorkbook.Worksheets("NSR FORM")
If Sheet.Shapes("Check Box 82").ControlFormat.Value = 0 Then
Sheet.Range("J39").PasteSpecial Paste = "" :Exit sub <<< to exit direct from your project
ElseIf Sheet.Shapes("Check Box 82").ControlFormat.Value = 1 Then
Sheet.Range("J39").PasteSpecial Paste = "3.8"
End If
End Sub
Related
I created a couple of user forms which operate a data in separate report workbook. My script can successfully proceed a value in digit type. Unfortunately the circumstances have changed and now it has to work with a Serial Numbers as: 29160012040000TZ. With that new value script after starting the Sub, open a report, but it never enter into a 'with' statement. It doesn't look for a value or doing something else. Just open a report workbook and freeze.
Below you can see the code lines where issue is present and a little description:
Single_PHA is a text window in User Form where user can enter a a value, proceeding value is 29160012040000TZ
Private Sub Wydaj_button_Click()
Workbooks.Open Filename:="N:\ENGINEERING\1. ENGINEERS\Mateusz Skorupka\PHA_Cleaning_report_path\PHA_CLEANING_REPORT.xlsm", ReadOnly:=False
Dim REPORT As Workbook
Set REPORT = Application.Workbooks("PHA_CLEANING_REPORT.xlsm")
Set TABLE = REPORT.Worksheets("Main_table")
...
With TABLE.Range("A1")
If Single_PHA = True Then
If Not IsError(Application.Match(Single_PHA.Value, .Range("A:A"), 0)) Then
Single_PHA_row = TABLE.Range("A:A").Find(What:=Single_PHA.Value, LookIn:=xlValues).Row
.Offset(Single_PHA_row - 1, 4).Value = Date
REPORT.Close SaveChanges:=True
Single_PHA.Value = ""
Exit Sub
Else
MsgBox "Numer seryjny głowicy nie istnieje w bazie"
REPORT.Close SaveChanges:=False
Exit Sub
End If
End If
End With
In VBA I don't know how to open something like debugger or make the print instruction which would show me how the variables look on specific steps.
I am not sure if VBA read the value as 29160012040000TZ as string. I tried to declare at the beginning a variable as Single_PHA_STR as String and the proceed it as just text, but no wins there:
Dim Single_PHA_STR As String
...
With TABLE.Range("A1")
If Single_PHA = True Then
Single_PHA_STR = Str(Single_PHA.Value)
If Not IsError(Application.Match(Single_PHA_STR, .Range("A:A"), 0)) Then
Single_PHA_row = TABLE.Range("A:A").Find(What:=Single_PHA_STR, LookIn:=xlValues).Row
.Offset(Single_PHA_row - 1, 4).Value = Date
REPORT.Close SaveChanges:=True
Single_PHA.Value = ""
Exit Sub
Else
MsgBox "Numer seryjny głowicy nie istnieje w bazie"
REPORT.Close SaveChanges:=False
Exit Sub
End If
End If
End With
I noticed that if in VBA IDE I write a bold value 29160012040000TZ, I get an error
Expected line number or label or statement or end of statement
and the value is highlighted in red.
Could someone help me in that field and explain the nature of issues:
To reproduce a situation you can create a simply user form with one TextBox and one CommandButton. In the same worksheet as user form in a column A put a values: 29160012040000 and 29160012042027IR
Then make a sub which execute after double click on command button with code:
Private Sub CommandButton1_Click()
With Worksheets("Sheet1").Range("A1")
If Text_box1 = True Then
If Not IsError(Application.Match(Text_box1.Value, .Range("A:A"), 0)) Then
Text_box1_row = Worksheets("Sheet1").Range("A:A").Find(What:=Text_box1.Value, LookIn:=xlValues).Row
.Offset(Text_box1_row - 1, 4).Value = Date
Text_box1.Value = ""
Exit Sub
Else
MsgBox "PHA SN not exist in a database"
Exit Sub
End If
End If
End With
End Sub
Then try to input in a UserForm's TextBox a value = 29160012040000 and you will see that script successfully filled a forth column in row with current date. Then try to input a value 29160012042027IR and you will see that nothing happened. Script don't proceed that value at all.
So that is my issue and question indeed. How to process a value with letters at the end like: 29160012042027IR : )
I also tried to focus a script statement on one specific cell in which is a text value "29160012042027IR" that which I input into a UserForm TextBox. Looking with a debugger both of variables in if statement have the same text value, but still script miss that statement and go to else instructions : (
I mean abut: If Range("A3").Text = Text_box1.Text Then
When I change a statement for "If Range("A3").Value = Text_box1.Value Then" the same thing happen.
Private Sub CommandButton1_Click()
With Worksheets("Sheet1").Range("A:A")
If Text_box1 = True Then
If Range("A3").Text = Text_box1.Text Then
Text_box1_row = Worksheets("Arkusz1").Range("A:A").Find(What:=Text_box1.Value, LookIn:=xlWhole).Row
.Offset(Text_box1_row - 1, 4).Value = Date
Text_box1.Value = ""
Exit Sub
Else
MsgBox "PHA SN not exist in a database"
Exit Sub
End If
Else
MsgBox "Other loop"
End If
End With
End Sub
IMPORTANT NOTICE:
I found the main issue. I made wrong if condition, it should be:
If Single_PHA <> "" Then previously I have got: If Single_PHA = True Then, and there the results is a value not the boolean type.
Everything works. Thank everyone very much for help.
Topic is ready to be closed.
PS: thank you Tom for suggestion and tip with debugger: )
Apologies any incorrect terms, this is the first time I am trying to code a macro. I currently have the following code running:
Private Sub Worksheet_Deactivate()
'Alpha Show / Hide
If Sheets("Project_selection").Range("D4") = Range("C2") Then
Sheet3.EnableCalculation = True
ElseIf Sheets("Project_selection").Range("D4") = "All" Then
Sheet3.EnableCalculation = True
Else
Sheet3.EnableCalculation = False
End If
End Sub
which has been cobbled together from other codes and google. It works, but only when I move out of the sheet, which I think is being driven by the first line.
I would actually like it to activate when the Cell D4 in the 'Project_selection' sheet (a separate sheet to the one the code is on) gets changed - does anyone know how I would do that? I have seen references to worksheet_change, but I do not understand how one defines the target/range to get the appropriate reference.
Hope that makes sense and thanks in advance!
If you were to place the following code under the sheet (Project_selection), it would fire that event every time a change has happened in Cell D4:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet: Set ws = Sheets("Project_selection")
If Target.Address = "$D$4" Then
If ws.Range("D4") = ws.Range("C2") Then
Sheet3.EnableCalculation = True
ElseIf ws.Range("D4") = "All" Then
Sheet3.EnableCalculation = True
Else
Sheet3.EnableCalculation = False
End If
End If
End Sub
Hello everyone and thank you!
I have some wierd exception that I cannot solve.
It is not my first program though I cannot figure it out!
I'm writing an application wich through it I want to fill an excel workbook.
every time i'm trying to merge cells, I'm recieving an error.
I have checked over and over and I just can't figure it out.
everything in my code supposed to work.
the xl application,workbook,worksheet and ranges all declared.
the wierdest is that if during the code running, i'm entering the excel worksheet manualy (after pausing the program with a msgbox or something), and
selecting some cell (no matter wich), the code is running just fine :(((
Im not aloud to add in images so here is the code - copy paste.
the btn click code:
Private Sub btnCreatPriceQuote_Click(ByVal sender As Object, ByVal e As EventArgs) Handles btnCreatPriceQuote.Click
oXL.Visible = False
Dim indexForCopy As Integer
'few commands for faster run in the xl WB
XlFasterRun()
'Replace pricequote sheet with its format to avoid overwrite
PriceQuoteRenew()
'Decalre rows for add details on the BAMAY
DecalreFirstRow()
FillPriceQuoteTable()
TillIndex = 39
EmptyCellIndex = 13
the declaration from a module:
`Public Sub DecalreFirstRow()
rng1thcol1thLinePQ = shPriceQuote.Range("A75:D75")
rng2thcol1thLinePQ = shPriceQuote.Range("E75:F75")
rng3thcol1thLinePQ = shPriceQuote.Range("G75:H75")
rng4thcol1thLinePQ = shPriceQuote.Range("I75:J75")
rng5thcol1thLinePQ = shPriceQuote.Range("K75:L75")
rng6thcol1thLinePQ = shPriceQuote.Range("M75:N75")
rng7thcol1thLinePQ = shPriceQuote.Range("O75:T75")
rng8thcol1thLinePQ = shPriceQuote.Range("U75:X75")
rng1thcol1thLineCF = shCusFile.Range("A12:G12")
rng2thcol1thLineCF = shCusFile.Range("H12:K12")
rng3thcol1thLineCF = shCusFile.Range("L12:O12")
rng4thcol1thLineCF = shCusFile.Range("P12:S12")
rng5thcol1thLineCF = shCusFile.Range("T12:W12")
rng6thcol1thLineCF = shCusFile.Range("X12:AA12")
rng7thcol1thLineCF = shCusFile.Range("AD12:AI12")
rng8thcol1thLineCF = shCusFile.Range("AJ12:AN12")
End Sub
`
public sub where the exception occured:
Public Sub FillPriceQuoteTable()
With rng1thcol1thLinePQ
.Select()
.Value = rng1thcol1thLineCF.Value
**.Merge()**
End With
With rng2thcol1thLinePQ
.Select()
**.Merge()**
.Value = rng2thcol1thLineCF.Value
End With
With rng3thcol1thLinePQ
.Select()
**.Merge()**
.Value = rng3thcol1thLineCF.Value
End With
With rng4thcol1thLinePQ
.Select()
**.Merge()**
.Value = rng4thcol1thLineCF.Value
End With
Replace:
rng.Merge()
With:
rng.mergecells=true.
I am trying to assign a numeric value in VBA for a dropdown formfield. I have the Msgbox just to test functionality:
Sub ScreenB()
Dim a As Double
If ActiveDocument.FormFields("Dropdown9").DropDown.Value = No Then
a = 1
Else
a = 2
End If
MsgBox a
End Sub
With this code, my Msgbox does not change (it reads "2"), even when I change the the dropdown from Yes to No, or vice-versa. I also tried putting quotes around yes ("Yes") in the VBA code and got a Type Mismatch error.
You should use FormFields.Result
Sub ScreenB()
Dim a As Double
If ActiveDocument.FormFields("Dropdown9").Result = "No" Then
a = 1
Else
a = 2
End If
MsgBox a
End Sub
I'm trying to change the background color of a form control checkbox via VBA code. I've tried every variation of code I can find on the internet and am still getting failures.
The line I have currently is below, and is the only one I've found so far that doesn't give me compiler errors. When I run it though I get a "Run-time error '438': Object doesn't support this property or method" error on executing this line. This is true whether I set it = to xlBlack, RGB(255,255,255) or "11398133" (not black I know, but I was just trying to see if any color would work).
Anyone know what's going on and how I can actually do this?
Sheets("Controls").Shapes.Range(Array("Check Box 8")).BackColor = "11398133"
Answer
I found the answer. For some reason none of the responses worked, but Johnny's answer did help me get closer to it by loading the right object in memory and I could then use the Locals window to track down the property I wanted.
In the end it was identifying the object as Johnny suggested and then just cb.Interior.Color = xlBlack I was looking for. No .Fill and no .DrawingObject. Not sure what makes this different than others that would make that work that way, but there you go.
So, for any others who come looking, the code that ended up working for me was the simple addition of the below, and you can find out what the Excel name of the object is (Check Box 8 in my case) by selecting it while recording macros.
For Each cb In Sheets("Controls").CheckBoxes
If cb.Name = "Check Box 8" Then
cb.Interior.Color = xlNone
Exit Sub
End If
Next
This should do it for you. Follow these steps:
Make some form check boxes on a sheet
Copy the below code into a module (alt F11, insert, module)
run SetMacro
Save and test
code:
Sub SetMacro()
Dim cb, ws
For Each ws In ThisWorkbook.Sheets
For Each cb In ws.CheckBoxes
If cb.OnAction = "" Then cb.OnAction = "CheckedUnchecked"
Next cb
Next ws
End Sub
Sub CheckedUnchecked()
With ActiveSheet.Shapes(Application.Caller).DrawingObject
If .Value = 1 Then
.Interior.ColorIndex = 4
Else
.Interior.ColorIndex = 2
End If
End With
If you're only looking to do it on the active sheet, use this block instead:
Sub SetMacro()
Dim cb
For Each cb In ActiveSheet.CheckBoxes
If cb.OnAction = "" Then cb.OnAction = "CheckedUnchecked"
Next cb
End Sub
Sub CheckedUnchecked()
With ActiveSheet.Shapes(Application.Caller).DrawingObject
If .Value = 1 Then
.Interior.ColorIndex = 4
Else
.Interior.ColorIndex = 2
End If
End With
End Sub
Another possibility is that you want to set the ForeColor not the BackColor.
Very simply:
Sub changegColor()
Dim wb As Workbook
Dim ws As Worksheet
Dim cb As Object
Dim rng As Range
Set wb = ActiveWorkbook
Set ws = wb.ActiveSheet
Set cb = ws.Shapes.Range(1)
With cb.Fill
.Solid
.ForeColor.RGB = RGB(0, 255, 0)
End With
End Sub