At the moment I'm working on making a working code smaller using an array. I will explain the code shortly;
If a certain part is required to be in a datasheet (this worksheet is called "High Pressure Grinding Rolls"), then the user can define this by putting in value "a" on Sheets("Invulformulier"). Now there are several parts which can be on the datasheet if the cell value is "a". If we have "partA", "partB" and "partC", the RangeName of the cell will be the name of the part on Sheets("Invulformulier"). The RangeName of the range on Sheets("High Pressure Grinding Rolls") will be the name of the part + "1". For example "partA1". This range must be hidden depending on if the user puts in "a" for "partA".
This is the code I used and worked, but is specific to the cell names:
Sub Hidecellv1 ()
If Range("partA").Value = "a" Then
Sheets("High Pressure Grinding Rolls").Range("partA1").EntireRow.Hidden = False
ElseIf Range("partA").Value = "" Then
Sheets("High Pressure Grinding Rolls").Range("partA1").EntireRow.Hidden = True
End If
End Sub
This code is very specific and I want to make an array. This is what I have so far:
Sub Hidecellwitharray ()
Dim rngName As Range
Dim cell As Range
Application.ScreenUpdating = False
For Each cell In Range("Checkbox") 'Where user puts in value "a" or not
If cell.Value = "a" Then
Sheets("High Pressure Grinding Rolls").Range(RangeName & "1").EntireRow.Hidden = False
Else
Sheets("High Pressure Grinding Rolls").Range(RangeName & "1").EntireRow.Hidden = True
End If
Next cell
Application.ScreenUpdating = True
End Sub
The searching for value "a" for every part works, but I can't get it to work to hide the parts in the datasheet if value "a" is or isn't inserted. How do I refer to a variable RangeName?
If I correctly understood your issue you could try this:
Option Explicit
Sub Hidecellwitharray()
Dim cell As Range
Application.ScreenUpdating = False
For Each cell In Range("Checkbox") 'Where user puts in value "a" or not
Sheets("High Pressure Grinding Rolls").Range(Split(cell.Name.Name, "!")(1) & "1").EntireRow.Hidden = Not cell.Value = "a"
Next cell
Application.ScreenUpdating = True
End Sub
Does this do as you require? It will hide all named ranges on the 'High Pressure Grinding Rolls' sheet, then show the row containing the corresponding checkbox value.
I found helpful information on the following page: Loop through all named ranges in a Excel Sheet
Sub Hidecellv1()
Dim nm
Dim rngName
For Each nm In ThisWorkbook.Names
If Left(nm.Name, 4) = "Part" Then
Sheets("High Pressure Grinding Rolls").Range(nm).EntireRow.Hidden = True
End If
Next nm
rngName = Range("checkbox").Value
Sheets("High Pressure Grinding Rolls").Range("Part" & rngName & "1").EntireRow.Hidden = False
End Sub
Related
mycode :-
Public Sub CombineCells()
'Use to mash all cells with there contents into one
Dim selectedCells As Range
Dim cell As Range
Dim cellText As String
Application.DisplayAlerts = False
cellText = ""
Set selectedCells = Selection
For Each cell In selectedCells
cellText = cellText & cell.Value & " "
Next
selectedCells.merge
selectedCells.Value = Trim(cellText)
selectedCells.WrapText = True
Application.DisplayAlerts = True
End Sub
Basically I want to merge cells from A1 to H6, Range A1:H6, into the same cell without losing the data in the cells (they are going to have the same number in every cell((like same value/)) when I run my code, it saves the date and merges the cells but the numbers are going like this
But I want it to be like this (merged into one cell and without the border.
What am I doing wrong in my code?
I cant imagine why you would want to merge cells in such a way, but you were close none the less.
Since your range is static, define your range explicitly. Avoid .Selection & .Select when possible.
Sub Test()
Dim selectedCells As Range
Dim cell As Range
Dim cellText As String
Application.DisplayAlerts = False
cellText = ""
Set selectedCells = Range("A1:H6")
For Each cell In selectedCells
cellText = cellText & cell.Value & " "
Next
selectedCells.Merge
selectedCells.Value = Trim(cellText)
selectedCells.WrapText = True
Application.DisplayAlerts = True
End Sub
You can find lists of cell appearance properties online or here is the first one Google pulled for me. here
You can use the With feature to quickly apply a bunch of formats to your range without having to continuously qualify the range
With selectedcells
.Merge
.Value = Trim(cellText)
.WrapText = True
End With
I am attempting to find the text of a header row based on the value of a cell relative to the cell that is clicked in. The way I have attempted to do this is follows:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim var1 As Variant
Dim var2 As Variant
Dim var3 As Variant
Dim FormName As String
FormName = "New Form"
Static NewFormCell As Range
Application.ScreenUpdating = False
If Not Intersect(Target, Range("G16:X80")) Is Nothing Then
If Target.Cells.Count = 1 Then
var1 = Cells(Target.Row, 2).Value
var2 = Cells(15, Target.Column).Value
If Not (IsEmpty(var1)) And Not (IsEmpty(var2)) And var2 <> "+" And Target.Interior.ColorIndex <> 2 And Target.Borders(xlEdgeLeft).LineStyle <> xlNone Then
If IsEmpty(Target) Then
Target.Value = "X"
Target.HorizontalAlignment = xlCenter
Target.VerticalAlignment = xlCenter
Target.Font.Bold = True
Dim Header As Range
Set Header = Range("A54:E160").Find(var2, LookIn:=xlValues)
Header.Offset(1, 1).End(xlDown).EntireRow.Select
Dim CopyCell As Range
'Header.End(xlDown).EntireRow.Insert
'Set CopyCell = Header.End(xlDown). [offset?]
'CopyCell.Value = var1
Else
Target.ClearContents
End If
Else
Exit Sub
End If
End If
End If
Application.ScreenUpdating = True
End Sub
The issue is VBA is throwing Run-Time Error 91 ("Object variable or With block variable not set"). It then highlights the last row in that section of code. Since I set that variable in the previous line, I'm not sure why I'm receiving this error or if I'm even going about this the right way.
Any input would be greatly appreciated!
EDIT: I cleared the above issue by searching over a wider range. The cell I wanted to select was merged, but I still assumed the value was stored within column A. But this code still isn't quite doing what I'd like it to:
I want to select the last row in the section (not the last row of data in the sheet, but the last contiguous data in column B), but right now my code is jumping me all the way to the bottom of the sheet.
The problem is that your .Find isn't finding the value. In this case, you can add some code to handle that.
...
Dim Header As Range
Set Header = Range("A59:A159").Find(var2, LookIn:=xlFormulas)
If Header Is Nothing Then
' There's no value found, so do something...
msgbox(var2 & " was not found in the range, will exit sub now."
Exit Sub
End If
MsgBox Header
...
...of course there are myriad ways/things you can do to handle this. If you still want to execute other code, then wrap everything in an If Header is Nothing Then // 'do something // Else // 'other code // End IF type thing.
It really just depends on what you want to do. Again, your error is being caused by the fact that the var2 isn't being found, so just find other things to do in that case.
I wrote a function which for each checkbox in document check if field C140 is empty if is then uncheck checkbox in same row.
Sub MarkCheckBoxes()
Dim chk As CheckBox
Dim ws As Worksheet
Set ws = ActiveSheet
For Each chk In ws.CheckBoxes
If ws.Range("C140").Value = "" Then
chk.Value = False
Else
chk.Value = True
End If
Next chk
End Sub
Now I want change it that for each row check if mandatory fields are empty if is then uncheck checkbox in the same row as empty field, also I need clean row color by:
EntireRow.Interior.ColorIndex = xlColorIndexNone
When I changed range("c140") to range("c140:c150") then I had an error mismatch..
ALSO
Ralph give me an answer for first part, but now I have another problem.
I'd like to make some function which allow me check if any of field in row 149 is text "Mandatory then it check if rows belows are empty if is then do uncheck. So I tried sth like this:
If ws.Rows("149") = "Mandatory" Then
If ws.Range("C" & chk.TopLeftCell.Row).Value
But I don't have any idea how to write second if to check value in each column
Use the Cells property of the Worksheet instead of the Range like this in your If statent:
If ws.Cells(3, chk.TopLeftCell).Value = ""
I believe you might be looking for something like this:
Sub MarkCheckBoxes()
Dim chk As CheckBox
Dim ws As Worksheet
Set ws = ActiveSheet
For Each chk In ws.CheckBoxes
If ws.Range("C" & chk.TopLeftCell.Row).Value = vbNullString Then
chk.Value = False
Else
chk.Value = True
End If
Next chk
End Sub
Explanations:
I changed merely the row for C140 to C + the row number in which the checkbox is located. I hope this is what you've been looking for.
In respect to your initial attempt to change Range("C140") (which is one cell) to a range of cells like C140:C150: of course that cannot work. That would be like please compare this apple to these 10 apples. In return you would get 10 answers some of which might be true and others might be false for your If clause. VBA wouldn't know which ones of the ture or the false to take.
I apologize if this is posted elsewhere, but I am having issues understanding the relationship between the sub calling the user form and the user form controls. I have a sub that will populate data into a worksheet from another worksheet. One of the cells that needs to be filled out is an explanation for the change in quantities of the project. I generated a user form with option buttons that the user can select the appropriate "reason" from. Once the OK button is clicked it will place the selected reason in the cell of the worksheet.
In the sub, I am using For Each cell in the range to populate the data across the row for each value above a specific criteria and it should show the form for each cell meeting the criteria. Can I pass the cell I am using as a row reference into the user form so that it can use that cell as an offset to enter in the chosen "reason" then unload the form?
Private Sub okbutton1_Click(bc As Range) 'bc should be the range from the sub calling this form
Select Case True
Case OptionButton1
If bc.Offset(0, 3).Value = "A" Then
Set bc.Offset(0, 6).Value = "Actual amount required is more than plan quantity."
Else
Set bc.Offset(0, 6).Value = "Actual amount required is less than plan quantity."
End If
Case OptionButton2
Set bc.Offset(0, 6).Value = "This items was not constructed/used/required."
Case OptionButton3
Set bc.Offset(0, 6).Value = "Only a portion of the contingency was required for items not in original plan."
Case OptionButton4
Set bc.Offset(0, 6).Value = "Deficiency levied against Contractor per IDOT Section 105.03."
Case OptionButton5
Set bc.Offset(0, 6).Value = "Damages levied against Contractor per IDOT Section 108.09."
Case OptionButton6
Set bc.Offset(0, 6).Value = InputBox("Please enter your reasoning below.", "Other")
End Select
Unload AuthReason2
End Sub
Then this is a portion of the sub that I am working with to populate the worksheet.
Line5: 'Populates the BLR13210A from the data entered on the BLR13210
Application.ScreenUpdating = False
Dim bws As Worksheet
Set bws = Worksheets("BLR 13210A")
Dim Arange As Range
Set Arange = aws.Range("AZ34:AZ198")
Dim Bcell As Range ' First cell in AttachA form
Set Bcell = bws.Range("B11")
For Each ACell In Arange
If ACell.Value > 1999.99 Then
Bcell.Value = ACell.Offset(0, -47).Value
Bcell.Offset(0, 1).Value = ACell.Value
Bcell.Offset(0, 2).Value = ACell.Offset(0, -37).Value
Bcell.Offset(0, 3).Value = ACell.Offset(0, -22).Value
AuthReason2(Bcell).Show
End If
Bcell = Bcell.Offset(1, 0)
Application.ScreenUpdating = True
Thank you in advance for your assistance.
User forms should be used to retrieve user inputs and pass them to processing sub that will treat data accordingly
so you'd better act the opposite way, i.e.:
your main sub
should "launch" the user form and retrieve data from it, treat those data to act on other data and then close the user form
it could be like follows:
Option Explicit
Sub main()
Dim bws As Worksheet
Set bws = Worksheets("BLR 13210A")
Dim Bcell As Range ' First cell in AttachA form
Set Bcell = bws.Range("B11")
With UserForm1 '<--| change "UserForm1" to your actual userform name
.Tag = Bcell.Offset(0, 3).Value '<--| store the value you want to share with Userform in its 'Tag' property
.Show '<-- show the userform and have it process user inputs
Bcell.Offset(0, 6).Value = .Tag '<--| retrieve the value that userform has left in its 'Tag' property accordingly to user inputs
End With
Unload UserForm1 '<--| change "UserForm1" to your actual userform name
End Sub
of course you will change Bcell.Offset(0, 3).Value to whatever range value should fit your needs
your user form
will handle user inputs and pass them back to the sub
there are many ways it can be done, but the following could suit your needs
put in its code pane something like follows:
Option Explicit
Private Sub okbutton1_Click()
Dim txt As String
With Me '<--| reference the userform
Select Case True
Case .OptionButton1 '<--| with the dot (.) access the referenced object members (in this case its controls)
If .Tag = "A" Then '<--| query the value that the calling sub has left in the useform 'Tag' property
txt = "Actual amount required is more than plan quantity."
Else
txt = "Actual amount required is less than plan quantity."
End If
Case .OptionButton2
txt = "This items was not constructed/used/required."
Case .OptionButton3
txt = "Only a portion of the contingency was required for items not in original plan."
Case .OptionButton4
txt = "Deficiency levied against Contractor per IDOT Section 105.03."
Case .OptionButton5
txt = "Damages levied against Contractor per IDOT Section 108.09."
Case .OptionButton6
txt = InputBox("Please enter your reasoning below.", "Other")
Case Else '<--| you may want to handle the case when the user dosen't select any option
txt = "some text" '<--| change it to your needs
End Select
.Tag = txt '<--| use 'Tag' property to store the value you want to pass back to the calling sub
.Hide '<--| hide the userform
End With
End Sub
I've incorporated the off-sheet dependents search using the "ShowDependents" and "NavigateArrow" VBA methods. Everything works well but it is just painfully slow (for a large number of dependents).
Are there alternatives, way to speed it up? I've tried disabling the ScreenUpdating but that doesn't speed it up by much.
This is what my code is based on: http://www.technicana.com/vba-for-checking-dependencies-on-another-sheet
Consider the following function which is supposed to return true if the cell you pass it has a direct dependent on a different sheet:
Function LeadsOut(c As Range) As Boolean
Application.ScreenUpdating = False
Dim i As Long, target As Range
Dim ws As Worksheet
Set ws = ActiveSheet
c.ShowDependents
On Error GoTo return_false
i = 1
Do While True
Set target = c.NavigateArrow(False, i)
If c.Parent.Name <> target.Parent.Name Then
ws.Select
ActiveSheet.ClearArrows
Application.ScreenUpdating = True
LeadsOut = True
Exit Function
End If
i = i + 1
Loop
return_false:
LeadsOut = False
ActiveSheet.ClearArrows
Application.ScreenUpdating = True
End Function
Sub test()
MsgBox LeadsOut(Selection)
End Sub
To test it, I linked the test sub to a command button on Sheet1.
In A2 I entered the formula = A1 + 1, with no other formulas on Sheet1.
On Sheet2 I entered the formula =Sheet1!A2.
Back on Sheet1, if I select A2 and invoke the sub it almost instantly pops up "True". But if I select A1 and invoke the sub it returns "False" -- but only after a delay of several seconds.
To debug it, I put a Debug.Print i right before i = i + 1 in the loop. The Immediate Window, after running it again, looks like:
32764
32765
32766
32767
Weird!!!!!
I was utterly stumped until I replaced Debug.Print i by
Debug.Print target.Address(External:=True)
Which led to output that looks ends like:
[dependents.xlsm]Sheet1!$A$1
[dependents.xlsm]Sheet1!$A$1
[dependents.xlsm]Sheet1!$A$1
[dependents.xlsm]Sheet1!$A$1
NavigateArrow(False,i) goes back to the originating cell and stays there once i exceeds the number of dependents! This is seemingly undocumented and massively annoying. The code you linked to was written by someone who hasn't discovered this. As a kludge, you should check that when you are navigating arrows you haven't returned to the starting point. The following seems to work almost instantly in all cases, although I haven't tested it very much:
Function LeadsOut(c As Range) As Boolean
Application.ScreenUpdating = False
Dim i As Long, target As Range
Dim ws As Worksheet
Set ws = ActiveSheet
c.ShowDependents
On Error GoTo return_false
i = 1
Do While True
Set target = c.NavigateArrow(False, i)
If target.Address(External:=True) = c.Address(External:=True) Then
GoTo return_false
End If
If c.Parent.Name <> target.Parent.Name Then
ws.Select
ActiveSheet.ClearArrows
Application.ScreenUpdating = True
LeadsOut = True
Exit Function
End If
i = i + 1
Loop
return_false:
LeadsOut = False
ActiveSheet.ClearArrows
Application.ScreenUpdating = True
End Function
The key lines are the three lines which begin
If target.Address(External:=True) = c.Address(External:=True)
Adding some such check in the sub you linked to should make a massive difference.