I am new to Excel-VBA and I'm trying to add items in combo box depending on the cell color.
In this example, I only want the text of those blue shades be added on the combobox list.
Sheets("Application").ComboBox1.List = Range("A:A").Value
This code will go through out column A and if it finds a cell with specific color, it will add it to the combobox, this will occurred every time the sheet gets activated.
Option Explicit
Private Sub Worksheet_Activate()
Dim rng As Range
Dim i As Long
Dim LastRow As Long
Me.ComboBox1.Clear
With Sheets("Application")
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To LastRow
If .Cells(i, 1) <> vbNullString Then
If Cells(i, 1).Interior.Color = 12611584 Then
Me.ComboBox1.AddItem Cells(i, 1)
End If
End If
Next
End With
End Sub
Related
I have a simple Userform with two textboxes. User is to enter Part Description in one labelled "Panel ID" and the number of rows that description is to be entered in the same column of the spreadsheet (Quantity). By now, I am OK with adding value in empty row, but got stuck at copying the value to other cells. I have code for copying the value in set range, but cannot find anything that works for what I am looking for. Thanks
Apples Oranges List
Private Sub SubmitBtn_Click()
Dim iRow As Long, C As Long
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Data")
iRow = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1
C = QTYBox.Value
With sh
.Cells(iRow, 1) = TxtPanel.Value
End With
End Sub
Private Sub UserForm_Initialize()
'Empty Panel ID cell
TxtPanel.Value = ""
'Empty Quantity cell
QTYBox.Value = ""
'Set focus to panel ID cell
TxtPanel.SetFocus
End Sub
This is code for second problem:
crate form
crate spreadsheet
Private Sub SubmitBtn_Click()
Dim i As Long
Dim sh As Worksheet
Dim lRow As Long
Set sh = ThisWorkbook.Sheets("Data")
lRow = sh.Cells(Rows.Count, 1).End(xlUp).Row
With sh
For i = 2 To lRow
'Criteria search
If .Cells(i, 1).Value = PanelTxt.Value Then
If .Cells(i, 2).Value = IDTxt.Value Then
'Enter date in Crated and Crate #
.Cells(i, 5) = [Text(Now(), "DD-MM-YY HH:MM")]
.Cells(i, 6) = CrateTxt.Value
Exit For
End If
End If
Next
End With
End Sub
I am beginner at VBA, I am stuck plz help. In this image(linked at the end of paragraph), I am trying to insert line above the cells which contains different name than the name of upper cell. Plz tell me if there is an easier way to do this or how to apply the given if else condition to whole "G" Column...
Still I am adding my code below if you don't need the image...
Sub ScanColumn()
'Application.ScreenUpdating = False
Dim varRange As Range
Dim currentCell As String
Dim upperCell As String
Dim emptyCell As String
currentCell = ActiveCell.Value
bottomCell = ActiveCell.Offset(1, 0).Value
emptyCell = ""
Dim intResult As Integer
intResult = StrComp(bottomCell, currentCell)
Dim emptyResult As Integer
emptyResult = StrComp(currentCell, emptyCell)
'I want to apply below condition to whole G column in used range
If emptyResult = 0 Then
ActiveCell.Select
ElseIf intResult = 0 Then
ActiveCell.Offset(1, 0).Select
Else
ActiveCell.Offset(1).EntireRow.Insert
ActiveCell.Offset(2, 0).Select
End If
End Sub
Here you have, just call the function "evaluateColumn" and pass the parameters, as example the "trial" sub.
Function evaluateColumn(column As String, startRow As Long, wsh As Worksheet)
Dim lastRow As Long
lastRow = wsh.Range(column & wsh.Rows.Count).End(xlUp).Row
Dim i As Long: i = startRow
Do While i < lastRow
If wsh.Cells(i, column).Value <> wsh.Cells(i + 1, column).Value And wsh.Cells(i, column).Value <> "" And wsh.Cells(i + 1, column).Value <> "" Then
wsh.Range(column & i + 1).EntireRow.Insert shift:=xlShiftDown, CopyOrigin:=xlFormatFromLeftOrAbove
i = i + 1
lastRow = lastRow + 1
End If
i = i + 1
Loop
End Function
Sub trial()
evaluateColumn "G", 2, ThisWorkbook.Worksheets("Sheet2")
End Sub
As you can see from the difference between my answer and the one below, your question isn't entirely clear. My code is an event procedure. It will run automatically, as you select a cell within the used range of column G.
If the value of the selected cell is the same as the cell below it the next row's cell will be selected.
If there is a value in either of the two cells, a blank row will be inserted and that row's cell selected. (If you want another row enable the row below the insertion.)
If either of the above conditions are true, do nothing and proceed with the selection the user made.
In order to let this code work it must be installed in the code sheet of the worksheet on which you want the action. It will not work if you install it in a standard code module, like Module1.
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim TriggerRange As Range
Dim Off As Long ' offset from Target for selection
' if more than one cell is selected choose the first cell
If Target.Cells.CountLarge > 1 Then Set Target = ActiveCell
Set TriggerRange = Range(Cells(2, "G"), Cells(Rows.Count, "G").End(xlUp))
' this code will run only if a cell in this range is selected
' Debug.Print TriggerRange.Address(0, 0)
If Not Application.Intersect(Target, TriggerRange) Is Nothing Then
Application.EnableEvents = False
With Target
If .Value = .Offset(1).Value Then
Off = 1
ElseIf WorksheetFunction.CountA(.Resize(2, 1)) Then
Rows(.Row).Insert
' Off = 1 ' or -1 to change the selection
End If
.Offset(Off).Select
End With
Application.EnableEvents = True
End If
End Sub
This is really simple but I'm new to VBA.
I want to format cells in column J and K (haven't gotten to K yet) with a grey fill and border around if cells in column B is not empty. I want to do this in every worksheet in the workbook.
Sub forEachWs()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
Call Format_ForecastingTemplate(ws)
Next
End Sub
Sub Format_ForecastingTemplate(ws As Worksheet)
Dim cell As Range
Dim N As Long
Dim i As Long
N = Cells(Rows.Count, "B").End(xlUp).Row
For i = 1 To N
If cell <> "" Then
With ActiveSheet.Range(Cells("J"), cell.Row)
.ThemeColor = xlThemeColorDark1
.BorderAround LineStyle:=xlContinuous
End With
End If
Next
End Sub
The line that is giving me an error is If cell <> "" Then. I think it's because I'm not referencing the cell variable in column B?
Error is: Object variable or With block variable not set
Like this:
I changed it to a single macro and made changes to your original code
Sub Format_ForecastingTemplate()
Dim cell As Range
Dim N As Long
Dim i As Long
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
N = Cells(Rows.Count, "B").End(xlUp).Row
For i = 1 To N
'Looks at B to check if empty
If ws.Cells(i, 2).Value <> "" Then
'changes cells J to color and border
ws.Cells(i, 10).Borders.LineStyle = xlContinuous
ws.Cells(i, 10).Interior.ThemeColor = xlThemeColorDark1
ws.Cells(i, 10).Interior.TintAndShade = -0.25
End If
Next i
Next ws
End Sub
You can either change the column number or add new lines for column K
Hope this helps and please be kind and leave feedback. :)
I need your help. It seems what I have written in code does not accomplish what I am trying to do here.
The objective would be to have 2 userform combo boxes one for the (floor) values which are manually added once [3,4,5] and the other combo boxes (offices) in which values are dynamically added based on the selection made in the floor selection box.
Let's say for example that if I chose the value [3] in my floor combo box that the office combo box would contain the following values:
A-01
A-02
A-03
A-04
A-05
A-06
A-07
A-08
I thought this code would work but it doesn't:
'Cells(row, col)
Private Sub floor_Change()
lRow = Sheets("Office Spaces").UsedRange.Rows.Count
With Sheets("Office Spaces")
For i = 2 To lRow
If .Cells(i, 1).Value = UserForm1.floor.Value Then
UserForm1.office.AddItem .Cells(i, 2).Value
End If
Next i
End With
End Sub
Here's what the data looks in my excel sheet:
'Cells(row, col)
Private Sub floor56_Change()
UserForm1.office.Clear
Dim sh
Dim rw
Set sh = Sheets("Office Spaces")
For Each rw In sh.Rows
If sh.Cells(rw.row, 1).Text = UserForm1.floor.Value Then
UserForm1.office.AddItem (sh.Cells(rw.row, 2).Value)
End If
Next rw
End Sub
or
Private Sub floor_Change()
If UserForm1.floor.Value <> "" Then
UserForm1.office.Clear
Dim ws
Set ws = ThisWorkbook.Worksheets("Office Spaces")
Dim rng
Set rng = ws.Range("A:A")
For Each cell In rng
If cell.Text = UserForm1.floor.Value Then
UserForm1.office.AddItem (cell.Offset(0, 1).Value)
End If
Next cell
End If
End Sub
Good day guys I created a userform on excel with a combobox and a command button, the command button is for updating the data on the spread sheet based on the item selected on the combobox and a textbox with data, the problem is every time I click the command button it does not update the data, instead it goes to the next column and fill it in. and i want the data to be updated on the item selected
this is what I tried
Private Sub CommandButton6_Click()
Dim lrCD As Long
lrCD = Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Sheet2").Cells(lrCD + 1, "A").Value = ComboBox1.Text
Sheets("Sheet2").Cells(lrCD + 1, "B").Value = TextBox5.Text
Create your form as below:
Column A in Sheet2 contains unique values that will appear in your combobox.
This code sits within the form.
The UserForm_Initialize() event fires when you open the form and will populate the combobox with values.
The CommandButton6_Click event searches column A and places the text in textbox5 next to the selected value.
Private Sub UserForm_Initialize()
Dim lrCD As Long
'Populate ComboBox with values from column A on Sheet2.
With ThisWorkbook.Worksheets("Sheet2")
lrCD = .Range("A" & Rows.Count).End(xlUp).Row
Me.ComboBox1.RowSource = "'Sheet2'!" & .Range(.Cells(1, 1), .Cells(lrCD, 1)).Address
End With
End Sub
Private Sub CommandButton6_Click()
Dim rCell As Range
With ThisWorkbook.Worksheets("Sheet2")
'Look for the selected value in column A.
Set rCell = .Columns(1).Find( _
What:=Me.ComboBox1.Value, _
After:=.Cells(1, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole)
'If a value is found place the textbox value in the column next to it.
If Not rCell Is Nothing Then
rCell.Offset(, 1) = Me.TextBox5.Value
End If
End With
End Sub