I am trying to hide columns based on a value from another sheet. I have read several articles and don't feel like this is very difficult but am having some issues. When the value in Sheets("Data").Cells(2, 3) is 1 everything works fine but when I change it to 2,3 or 4 the code somehow highlights the entire spreadsheet and "hides" everything. Makes no sense. Below is one version using If..Then. I tried the same thing with select case and this same issue occurs.
Sub test()
Dim choice As Integer
Sheets("Summary").Select
Range("O:S").Select
Selection.EntireColumn.Hidden = True
choice = CInt(Sheets("Data").Cells(2, 3))
If choice = 1 Then
Range("O:P").Select
Selection.EntireColumn.Hidden = False
ElseIf choice = 2 Then
Range("Q:Q").Select
Selection.EntireColumn.Hidden = False
ElseIf choice = 3 Then
Range("R:R").Select
Selection.EntireColumn.Hidden = False
ElseIf choice = 4 Then
Range("S:S").Select
Selection.EntireColumn.Hidden = False
End If
Sheets("Summary").Cells(1, 1).Select
Try getting rid of selections. This code works for me.
Sub test()
Dim choice As Integer
Sheets("Summary").Activate
range("O:S").EntireColumn.Hidden = True
choice = CInt(Sheets("Data").Cells(2, 3))
If choice = 1 Then
range("O:P").EntireColumn.Hidden = False
ElseIf choice = 2 Then
range("Q:Q").EntireColumn.Hidden = False
ElseIf choice = 3 Then
range("R:R").EntireColumn.Hidden = False
ElseIf choice = 4 Then
range("S:S").EntireColumn.Hidden = False
End If
Sheets("Summary").Cells(1, 1).Select
End Sub
Related
I have a spreadsheet of products, which are in particular fonts and backgrounds. I am trying to create a macro so when I perform the find function (CLTR-F), I can click a macro button which will copy my selection, and paste it into the first available cell in Row N starting with the second row ("N2") and ending with the 12th row ("N12").
I have more data in N, for example in N13 and N14, so I cannot simply count the rows occupied and add one. I want to make this code work so this process exits once the first cell has been pasted into. Currently my code simply pastes the selected cell into both N2 and N3. The goal is that once the value is pasted, the process ends. But if the value is not pasted, it will go onto the next available cell and paste, and end, and so on if the cells are occupied until it is pasted in the first empty cell. Below is what I have, and so far it pastes into both N2 and N3, (If N2 is not occupied.)
Sub CopyPasteFirstEmptyCell()
'Copy the selection
Selection.Copy
'Test for N2
If IsEmpty(Range("N2")) = True Then
Selection.Copy Range("N2")
End If
'Test for N3
If IsEmpty(Range("N2")) = True Then
Selection.Copy Range("N3")
'Test For N4-N12 etc. etc.
End Sub
Thank you so kindly for listening. I have looked at relevant threads and have not found a sufficient answer of yet, and I apologize if that answer already exists openly.
I created variables and added them to a final variable to decide the range.
Sub Copy()
'Copy the selection
Selection.Copy
'Create variables
Dim intN2 As Integer
Dim intN3 As Integer
Dim intN4 As Integer
Dim intN5 As Integer
Dim intN6 As Integer
Dim intN7 As Integer
Dim intN8 As Integer
Dim intN9 As Integer
Dim intN10 As Integer
Dim intN11 As Integer
Dim intN12 As Integer
Dim finalint As Integer
'Create If Then statements to increaes finalint
'For N2
If IsEmpty(Range("N2")) = True Then
intN2 = 0
ElseIf IsEmpty(Range("N2")) = False Then
intN2 = 1
End If
'For N3
If IsEmpty(Range("N3")) = True Then
intN3 = 0
ElseIf IsEmpty(Range("N3")) = False Then
intN3 = 1
End If
'For N4
If IsEmpty(Range("N4")) = True Then
intN4 = 0
ElseIf IsEmpty(Range("N4")) = False Then
intN4 = 1
End If
'For N5
If IsEmpty(Range("N5")) = True Then
intN5 = 0
ElseIf IsEmpty(Range("N5")) = False Then
intN5 = 1
End If
'For N6
If IsEmpty(Range("N6")) = True Then
intN6 = 0
ElseIf IsEmpty(Range("N6")) = False Then
intN6 = 1
End If
'For N7
If IsEmpty(Range("N7")) = True Then
intN7 = 0
ElseIf IsEmpty(Range("N7")) = False Then
intN7 = 1
End If
'For N8
If IsEmpty(Range("N8")) = True Then
intN8 = 0
ElseIf IsEmpty(Range("N8")) = False Then
intN8 = 1
End If
'For N9
If IsEmpty(Range("N9")) = True Then
intN9 = 0
ElseIf IsEmpty(Range("N9")) = False Then
intN9 = 1
End If
'For N10
If IsEmpty(Range("N10")) = True Then
intN10 = 0
ElseIf IsEmpty(Range("N10")) = False Then
intN10 = 1
End If
'For N11
If IsEmpty(Range("N11")) = True Then
intN11 = 0
ElseIf IsEmpty(Range("N11")) = False Then
intN11 = 1
End If
'For N12
If IsEmpty(Range("N12")) = True Then
intN12 = 0
ElseIf IsEmpty(Range("N12")) = False Then
intN12 = 1
End If
'Make finalint the total of all other integers
finalint = intN2 + intN3 + intN4 + intN5 + intN6 + intN7 + intN8 + intN9 + intN10 + intN11 + intN12
'Place selection depending on amount of finalint
If finalint = 0 Then
Selection.Copy Range("N2")
ElseIf finalint = 1 Then
Selection.Copy Range("N3")
ElseIf finalint = 2 Then
Selection.Copy Range("N4")
ElseIf finalint = 3 Then
Selection.Copy Range("N5")
ElseIf finalint = 4 Then
Selection.Copy Range("N6")
ElseIf finalint = 5 Then
Selection.Copy Range("N7")
ElseIf finalint = 6 Then
Selection.Copy Range("N8")
ElseIf finalint = 7 Then
Selection.Copy Range("N9")
ElseIf finalint = 8 Then
Selection.Copy Range("N10")
ElseIf finalint = 9 Then
Selection.Copy Range("N11")
ElseIf finalint = 10 Then
Selection.Copy Range("N12")
End If
End Sub
I'm creating a workbook, which tracks available rentals per month. It is divided into 12 sheets, one for each month. The first three columns of each sheet track the type of accommodation, number of bedrooms and what's included in the rental price. The concept there is that there will be a drop-down combo box that allows the user to fill in with a point-and-click option rather than typing things out in order to reduce input errors.
I set up a fixed array, the contents in which changes depending on what column that active cell is in, and then the array is assigned to the combo box. The code lives in the Sheet1 Module under the combo box code and the ThisWorkbook module calls it under SheetSelectionChange, so as to avoid repeating the code in each sheet.
A Standard Module makes the array public
All 12 combo boxes share the same name, cboOptions, and they populate correctly, regardless of what sheet is chosen. My problem is that none of the combo boxes return the listindex value of the choice that's made, regardless of the code telling it to do so. I've been testing to see the value of the position returned against the value of the position chosen, but I have not been able to establish a pattern. I thought about clearing the variables and arrays, thinking that might be what's messing with the code, but it seems to be having no effect. I've read what I could on the issue, but I'm out of ideas on what might be the problem...thank you in advance!
Code in Sheet1 module:
Private Sub cboOptions_Change()
Erase myarray()
cboOptions.Visible = True
cboOptions.Enabled = True
cboOptions.Clear
n = ActiveCell.Row
If n >= 3 And n < 10000 Then
If ActiveSheet.Range(ActiveCell.Address).Address = Range("A" & n).Address Then
myarray(1) = "Apartment"
myarray(2) = "Room"
myarray(3) = "Townhouse"
myarray(4) = "House"
ElseIf ActiveSheet.Range(ActiveCell.Address).Address = Range("B" & n).Address Then
myarray(1) = "1"
myarray(2) = "2"
myarray(3) = "3"
myarray(4) = "4"
myarray(5) = "5"
ElseIf ActiveSheet.Range(ActiveCell.Address).Address = Range("C" & n).Address Then
myarray(1) = "Heat & Water"
myarray(2) = "All-inclusive"
Else
cboOptions.Enabled = False
cboOptions.Visible = False
End If
End If
'ActiveSheet.cboOptions.ListIndex = 0
'Dim x As Long
'MsgBox ActiveSheet.Name
With ActiveSheet
.cboOptions.Left = .Range(ActiveCell.Address).Left
.cboOptions.Top = .Range(ActiveCell.Address).Top
.cboOptions.List = myarray()
With .cboOptions
'the problem is that x needs to get assigned a value from the combo box before it continues to execute
x = .List(.ListIndex)
'MsgBox x
End With
.Range(ActiveCell.Address) = x 'myarray(x)
.Columns(ActiveCell.Column).ColumnWidth = cboOptions.Width * 0.18
x = 0
Erase myarray()
End With
End Sub
Code in ThisWorkbook:
Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Range)
Application.Run "Sheet1.cboOptions_Change"
End Sub
Code in Module1:
Option Explicit
Public myarray(0 To 5) As String
The nature of the problem seems to be that using more than one array for one combo box breaks down how the listindex values are calculated. I broke down the code to its component features to see if the issue persisted
1) Made a new file and put the code in Sheet1
2) Made separate fixed arrays for each kind of input
3) Created a separate routine for each kind of input
Using ON ERROR RESUME NEXT at the beginning of each routine overlooks the error and the code works properly. Alternatively, putting in a break where the integer variable is given the listindex value of the combo box allows the user to make a choice and assign a value to the integer variable, before continuing. Otherwise, its default value is -1 and returns an error; using .list(.listindex) did not make any difference, suggesting that the code needs to wait for user input (using a combobox event other than Change?).
May just need to establish a separate combo box for each column. Anyway, the code below is the sticks-and-stones version of the above, for a single sheet, and it will do the job if applied to each sheet module in the workbook:
Sub monthnames()
'add month names to the first cell of each sheet
Dim n As Integer
'Sheets(1).Activate
For n = 1 To 12
Sheets.Add After:=ActiveSheet
ThisWorkbook.Sheets(n).Cells(1, 1) = MonthName(n)
Next
End Sub
Private Sub cboOptions_Change()
Dim myarray(1 To 4) As String
Dim myarray2(1 To 5) As String
Dim myarray3(1 To 2) As String
cboOptions.Enabled = True
cboOptions.Visible = True
Dim n As Integer
n = ActiveCell.Row
If n >= 3 And n < 10000 Then
If Range(ActiveCell.Address).Address = Range("A" & n).Address Then
myarray(1) = "Apartment"
myarray(2) = "Room"
myarray(3) = "Townhouse"
myarray(4) = "House"
cboOptions.List = myarray()
inputdata myarray(), n
ElseIf Range(ActiveCell.Address).Address = Range("B" & n).Address Then
myarray2(1) = "1"
myarray2(2) = "2"
myarray2(3) = "3"
myarray2(4) = "4"
myarray2(5) = "5"
cboOptions.List = myarray2()
inputdata2 myarray2(), n
ElseIf Range(ActiveCell.Address).Address = Range("C" & n).Address Then
myarray3(1) = "Heat & Water"
myarray3(2) = "All-inclusive"
cboOptions.List = myarray3()
inputdata3 myarray3(), n
Else
cboOptions.Enabled = False
cboOptions.Visible = False
End If
End If
End Sub
Sub inputdata(myarray, n) 'myarray3, )
On Error Resume Next
Dim x As Integer
cboOptions.Left = Range(ActiveCell.Address).Left
cboOptions.Top = Range(ActiveCell.Address).Top
Columns(ActiveCell.Column).ColumnWidth = cboOptions.Width * 0.18
If Range(ActiveCell.Address).Address = Range("A" & n).Address Then
x = cboOptions.ListIndex + 1
Range(ActiveCell.Address) = myarray(x)
Else
Exit Sub
End If
End Sub
Sub inputdata2(myarray2, n)
On Error Resume Next
Dim y As Integer
cboOptions.Left = Range(ActiveCell.Address).Left
cboOptions.Top = Range(ActiveCell.Address).Top
Columns(ActiveCell.Column).ColumnWidth = cboOptions.Width * 0.18
If Range(ActiveCell.Address).Address = Range("B" & n).Address Then
y = cboOptions.ListIndex + 1
Range(ActiveCell.Address) = myarray2(y)
Else
Exit Sub
End If
End Sub
Sub inputdata3(myarray3, n)
On Error Resume Next
Dim z As Integer
cboOptions.Left = Range(ActiveCell.Address).Left
cboOptions.Top = Range(ActiveCell.Address).Top
Columns(ActiveCell.Column).ColumnWidth = cboOptions.Width * 0.18
If Range(ActiveCell.Address).Address = Range("C" & n).Address Then
z = cboOptions.ListIndex + 1
Range(ActiveCell.Address) = myarray3(z)
Else
Exit Sub
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call cboOptions_Change
End Sub
Hope you have an elegant solution for what is probably a simple problem!
I am using ActiveX option buttons, but within a worksheet and not a userform or a group box because of the way the sheet was designed. The code is contained as a sub within an option button code form.
This code is pretty self-explanatory of what I'm trying to do:
Public Sub SectionD_Click()
If OptionButton1.Value = True Then
ThisWorkbook.Sheets("Boolean").Range("B2").Value = 1
ElseIf OptionButton2.Value = True Then
ThisWorkbook.Sheets("Boolean").Range("B2").Value = 0
End If
If OptionButton3.Value = True Then
ThisWorkbook.Sheets("Boolean").Range("B3").Value = 1
ElseIf OptionButton4.Value = True Then
ThisWorkbook.Sheets("Boolean").Range("B3").Value = 0
End If
If OptionButton5.Value = True Then
ThisWorkbook.Sheets("Boolean").Range("B4").Value = 1
ElseIf OptionButton6.Value = True Then
ThisWorkbook.Sheets("Boolean").Range("B4").Value = 0
End If
End Sub
I would like to make it such that the number following "OptionButton" changes values using a simple 'i = i + 2' type statement but it seems some VBA variable/expression/object limitations will not let me (sorry I'm a noob here, not sure what the proper terminology should be).
Would really appreciate if anyone could point me in the right direction here! I have to look through 25 or so option button pairs, and I would very much like the code to just be 5 simple lines rather than a hundred over lines doing the same thing!
I can name that tune with one line of code!!
Public Sub SectionD_Click(): Dim i As Integer: Dim rw As Long: rw = 2: With Worksheets("Sheet1"): For i = 1 To 10 Step 2: If .OLEObjects("OptionButton" & i).Object.Value Then: Worksheets("Boolean").Cells(rw, "B").Value = 0: ElseIf .OLEObjects("OptionButton" & i).Object.Value Then: Worksheets("Boolean").Cells(rw, "B").Value = 0: End If: rw = rw + 1: Next: End With:End Sub:
But I think that 16 lines is prettier.
Public Sub SectionD_Click()
Dim i As Integer
Dim rw As Long
rw = 2
With Worksheets("Sheet1")
For i = 1 To 10 Step 2
If .OLEObjects("OptionButton" & i).Object.Value Then
Worksheets("Boolean").Cells(rw, "B").Value = 0
ElseIf .OLEObjects("OptionButton" & i).Object.Value Then
Worksheets("Boolean").Cells(rw, "B").Value = 0
End If
rw = rw + 1
Next
End With
End Sub
5 lines? Really? :)
That's the best I can do:
Option Explicit
Public Sub SectionD_Click()
With ThisWorkbook.Sheets("Boolean")
Call CheckValue(.OptionButton1, .OptionButton2, .Range("B2"))
Call CheckValue(.OptionButton3, .OptionButton4, .Range("B3"))
End With
End Sub
Sub CheckValue(btn1 As Object, btn2 As Object, my_cell As Range)
If btn1.Value Then
my_cell.Value = 1
ElseIf btn2.Value Then
my_cell = 0
End If
End Sub
i am writing a code that checks if the row is yellow and if the value of a cell is true, if both are positive, it should return a blank row and uncheck the checkbox list. Otherwise, it should return a yellow row. I have written the following code, but it is not working. I would appreciate your help
Sub desmarcar_antigos()
Dim i As Integer
For i = 130 To 2 Step -1
If Rows(i).EntireRow.Interior.ColorIndex = 6 Then
If Cells(i, 9).Value = "TRUE" Then
Rows(i).EntireRow.Interior.ColorIndex = 0 And Sheets("Planilha").CheckBox1.Value = False
Else
Rows(i).EntireRow.Interior.ColorIndex = 6
End If
End If
Next i
Application.ScreenUpdating = False
End Sub
You can't use And to run two statements in a single line. Change this line:
Rows(i).EntireRow.Interior.ColorIndex = 0 And Sheets("Planilha").CheckBox1.Value = False
To:
Rows(i).EntireRow.Interior.ColorIndex = 0
Sheets("Planilha").CheckBox1.Value = False
If you really want to run two statements on a single line, you can use :. For example:
Rows(i).EntireRow.Interior.ColorIndex = 0 : Sheets("Planilha").CheckBox1.Value = False
but it should be discouraged.
Also, you can check both your conditions using a single If. That way, your Else will run if either fails:
If Rows(i).EntireRow.Interior.ColorIndex = 6 And Cells(i, 9).Value = "TRUE" Then
Rows(i).EntireRow.Interior.ColorIndex = 0
Sheets("Planilha").CheckBox1.Value = False
Else
Rows(i).EntireRow.Interior.ColorIndex = 6
End If
I have two sets of data within my sheet - the first is 1 row per machine, the second is 13 rows per machine. From a drop down box the user will select values from 1, 2, 3, 4, 5, 10, 15, 20, 25, 30 which correspond to the number of machines.
When a value is selected the corresponding rows within the two data sets need to be hidden. For example, if the user selects 5, only the rows for machine 1 to 5 will show.
I have the following code so far, but wondering if there is a simplified way of doing this as I haven't yet added in the individual values (1-5), also how do I have this run when the value is select from the drop down list?
Sub HideRows()
If Range("F19") = "10" Then
Rows("31:60").EntireRow.Hidden = False
Rows("84:473").EntireRow.Hidden = False
Rows("41:60").EntireRow.Hidden = True
Rows("214:473").EntireRow.Hidden = True
ElseIf Range("F19") = "15" Then
Rows("31:60").EntireRow.Hidden = False
Rows("84:473").EntireRow.Hidden = False
Rows("46:60").EntireRow.Hidden = True
Rows("279:473").EntireRow.Hidden = True
ElseIf Range("f19") = "20" Then
Rows("31:60").EntireRow.Hidden = False
Rows("84:473").EntireRow.Hidden = False
Rows("51:60").EntireRow.Hidden = True
Rows("344:473").EntireRow.Hidden = True
ElseIf Range("f19") = "25" Then
Rows("31:60").EntireRow.Hidden = False
Rows("84:473").EntireRow.Hidden = False
Rows("56:60").EntireRow.Hidden = True
Rows("409:473").EntireRow.Hidden = True
ElseIf Range("f19") = "30" Then
Rows("31:60").EntireRow.Hidden = False
Rows("84:473").EntireRow.Hidden = False
End If
End Sub
Thank you
I'm providing a more generic solution. You need to use WOrksheet_Change in the Sheet's Module
Reference: http://msdn.microsoft.com/en-us/library/office/ff839775(v=office.15).aspx
Private Sub Worksheet_Change(ByVal Target As Range)
Debug.Print Target.Address
If Target.Address = "$A$1" Then 'change the address to the dropdown box cell you have
Debug.Print Target.Value
NumMachineShow = CLng(Target.Value)
Cells.EntireRow.Hidden = False ' reset, unhidden every row first
Rows(31 + NumMachineShow & ":60").EntireRow.Hidden = True ' hide the unwanted 1 row per machine here
Rows(61 + NumMachineShow * 13 & ":473").EntireRow.Hidden = True ' hide the detail, you need to modify the numbers yourself
End If
End Sub