I am trying to connect my NIGOcomboBox list with the ListBox1 list on my worksheet (DropDownMenus). Currently I have the NIGOcomboBox populating from
Private Sub UserForm_Initialize()
Dim cell As Range
'Populate NIGO dropdown menu from "DropDownMenus worksheet.
For Each cell In .Range("B2:B" & .Cells(Rows.Count, 2).End(xlUp).Row)
If Not IsEmpty(cell) Then NIGOcombobox.AddItem cell.Value
Next cell
End With
Then I have a ListBox that populates as follows:
Private Sub NIGOcombobox_Change()
With Worksheets("DropDownMenus")
.Activate
Select Case NIGOcombobox
'Populate NIGO Reason list by dropdown menu selection.
Case "AMRF"
For Each cell In .Range("C3:C" & .Cells(Rows.Count, 3).End(xlUp).Row)
If Not IsEmpty(cell) Then ListBox1.AddItem cell.Value
Next cell
Case "OATS"
For Each cell In .Range("D3:C" & .Cells(Rows.Count, 3).End(xlUp).Row)
If Not IsEmpty(cell) Then ListBox1.AddItem cell.Value
Next cell
Case Else
MsgBox "Please select a NIGO Reason"
End Select
End With
End Sub
Its not exactly working as planned. I need to make this so when the next person comes along to add a new item to the NIGOcombox it auto selects the next row so they do not have t adjust the code.
Example
NIGOCombobox is in sheet (DropDownMenus) column ("A2:A") and the ListBox1 is also on sheet (DropDownMenus) but starts on column ("C3:C"). Each column after - D, E, F G etc. correspond with the next NIGOCombobox item.
So, A2 =("C3:C"), B2 =("D3:D), C2 = ("E3:D") and so on. Than way when a new item is entered into the NIGOCombobox it auto attaches to the next Listbox row.
Hope this makes sense! Thank you
Not sure of your aim. The following code will load column B in NIGOcombobox and then seach for the selected value in the first row of Worksheets("DropDownMenus"). So, if you transpose your column B into the first row of Worksheets("DropDownMenus") (starting in C1), that row will behave like a "header", and this might work. PS: if you want to add to previously selected items, delete the line ListBox1.Clear
Private Sub UserForm_Initialize()
Dim cell As Range
'Populate NIGO dropdown menu from "DropDownMenus worksheet.
For Each cell In Worksheets("DropDownMenus").Range("B2:B" & Worksheets("DropDownMenus").Cells(Rows.Count, 2).End(xlUp).Row)
If Not IsEmpty(cell) Then NIGOcombobox.AddItem cell.Value
Next cell
End Sub
Private Sub NIGOcombobox_Change()
Dim TheValueInCombobox As String
Dim TheHeader As Range
Dim TheHeaderColumn As Long
Dim LastRow As Long
ListBox1.Clear
TheValueInCombobox = NIGOcombobox.Value
Set TheHeader = Worksheets("DropDownMenus").Range("A1:Z1").Find(TheValueInCombobox) 'You might want to expand the range
TheHeaderColumn = TheHeader.Column
LastRow = Worksheets("DropDownMenus").Cells(Rows.Count, TheHeaderColumn).End(xlUp).Row
For Each cell In Worksheets("DropDownMenus").Range(Cells(3, TheHeaderColumn), Cells(LastRow, TheHeaderColumn))
If Not IsEmpty(cell) Then ListBox1.AddItem cell.Value
Next cell
End Sub
EDIT:
There is no need to have the values for populating NIGOcombobox in a dedicated column: you can scan the headers directly. This way data structure would be clearer (I think).
Private Sub UserForm_Initialize()
Dim cell As Range
Dim lColumn As Long
'Populate NIGO dropdown menu from "DropDownMenus worksheet.
lColumn = Worksheets("DropDownMenus").Cells(1, Columns.Count).End(xlToLeft).Column
For Each cell In Worksheets("DropDownMenus").Range(Cells(1, 3), Cells(1, lColumn))
If Not IsEmpty(cell) Then NIGOcombobox.AddItem cell.Value
Next cell
End Sub
Private Sub NIGOcombobox_Change()
Dim TheValueInCombobox As String
Dim TheHeader As Range
Dim TheHeaderColumn As Long
Dim LastRow As Long
Dim lColumn As Long
ListBox1.Clear
TheValueInCombobox = NIGOcombobox.Value
lColumn = Worksheets("DropDownMenus").Cells(1, Columns.Count).End(xlToLeft).Column
Set TheHeader = Worksheets("DropDownMenus").Range(Cells(1, 3), Cells(1, lColumn)).Find(TheValueInCombobox)
TheHeaderColumn = TheHeader.Column
LastRow = Worksheets("DropDownMenus").Cells(Rows.Count, TheHeaderColumn).End(xlUp).Row
For Each cell In Worksheets("DropDownMenus").Range(Cells(3, TheHeaderColumn), Cells(LastRow, TheHeaderColumn))
If Not IsEmpty(cell) Then ListBox1.AddItem cell.Value
Next cell
End Sub
Related
I have a ComboBox5 - which I want to populate from an excel worksheet (FaultLog). The values I wish to use are in Column B on the worksheet, but I only want them populated if Column O is blank.
Tried the code below!
I've created a range in the FaultLog sheet called "OpenFaults" but don't know how to filter the range.
Thanks in advance
Private Sub UserForm_Initialize()
Dim myfilter As String
Dim cell As Range, Thisrow As Long, Lastrow As Long
Worksheets(FaultLog).AutoFilterMode = False 'turns off
myfilter = ""
Range("OpenFault").AutoFilter Field:=14, Criteria1:=myfilter
ComboBox5.Clear
'ComboBox1.RowSource = "TestMaterial"
For Each cell In Range("OpenFault")
Thisrow = cell.Row
If Not cell.Rows.Hidden And Thisrow <> Lastrow Then
ComboBox5.AddItem cell.value
End If
Lastrow = Thisrow
Next cell
End Sub
Welcome to SO, Use Userform Initialize function to load combobox as below
Private Sub UserForm_Initialize()
Dim cell As Range, OpenFaults As Range
Set OpenFaults = YOURRANGE 'your values to be populated - range
With Sheets("FaultLog")
If Not WorksheetFunction.CountA(.Range("O:O")) = 0 Then
For Each cell In OpenFaults
ComboBox5.AddItem cell.Value
Next
End If
End With
End Sub
I have a table where sometimes there is data missing in the Column G (7th).
So far I selected a range in this column with my mouse and then ran this macro to fill empty cells with "No Data":
Sub FillEmptyCell()
Dim cell As Range
Dim InputValue As String
For Each cell In Selection
If IsEmpty(cell) Then
cell.Value = "No Data"
End If
Next
End Sub
However data in that column keeps getting more and I would like to automatically select the entire table range of the 7th column and fill empty cells with "No Data".
How do I implement this?
Try this
Dim lr As Long
lr = Cells(Rows.Count, 7).End(xlUp).Row
Dim Rng As Range
Set Rng = Range("G1:G" & lr)
For Each cell In Rng
If IsEmpty(cell) Then
cell.Value = "No Data"
End If
Next
I have a worksheet named "Input" with a Button (ActiveX) and a TextBox (ActiveX). I used VBA to check value of the TextBox when a user clicks the button, but the code cant find the textbox.
My code for the button:
Sub Toevoegen()
Dim invoerenws As Worksheet
Dim overzichtws As Worksheet
Dim nextRow As Long
Dim oCol As Long
Dim myRng As Range
Dim myCopy As String
Dim myCell As Range
'cells to copy from Input sheet - some contain formulas
myCopy = "TextBox1"
Set invoerenws = Worksheets("invoeren")
Set overzichtws = Worksheets("overzicht")
With overzichtws
nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
End With
With invoerenws
Set myRng = .Range(myCopy)
If Application.CountA(myRng) <> myRng.Cells.Count Then
MsgBox "Please fill in all the cells!"
Exit Sub
End If
End With
With overzichtws
With .Cells(nextRow, "A")
.Value = Now
.NumberFormat = "mm/dd/yyyy hh:mm:ss"
End With
.Cells(nextRow, "B").Value = Application.UserName
oCol = 3
For Each myCell In myRng.Cells
overzichtws.Cells(nextRow, oCol).Value = myCell.Value
oCol = oCol + 1
Next myCell
End With
'clear input cells that contain constants
With invoerenws
On Error Resume Next
With .Range(myCopy).Cells.SpecialCells(xlCellTypeConstants)
.ClearContents
Application.GoTo .Cells(1) ', Scroll:=True
End With
On Error GoTo 0
End With
End Sub
If the values are still inside the textBox then you have to reference the object or the control. you can do it like this:
textBox.value = worksheet.cells(1,1)
What this will do is display the value of textBox form control to cell A1. I know this is not what you are looking for but this is the simplest way of showing you how to reference userform objects or controls. You can find the name of a textBox control on a window like this:
You need to use the (Name) when referencing textboxes
I'm looking for some code that will look at Column A and as long as the cell in Column A is not blank, then the corresponding cell in Column B will equal a specific value.
So if Cell A1 <> "" then Cell B1.Value = "MyText"
And repeat until a cell in Column A is blank or empty.
To add a little more clarification, I have looked through the various loop questions asked and answered here. They were somewhat helpful. However, I'm unclear on how to get the loop to go through Column A to verify that each cell in Column A isn't blank AND in the corresponding cell in Column B, add some text that I specify.
Also, this will need to be part of a VBA macro and not part of a cell formula such as =IF
If you really want a vba solution you can loop through a range like this:
Sub Check()
Dim dat As Variant
Dim rng As Range
Dim i As Long
Set rng = Range("A1:A100")
dat = rng
For i = LBound(dat, 1) To UBound(dat, 1)
If dat(i, 1) <> "" Then
rng(i, 2).Value = "My Text"
End If
Next
End Sub
*EDIT*
Instead of using varients you can just loop through the range like this:
Sub Check()
Dim rng As Range
Dim i As Long
'Set the range in column A you want to loop through
Set rng = Range("A1:A100")
For Each cell In rng
'test if cell is empty
If cell.Value <> "" Then
'write to adjacent cell
cell.Offset(0, 1).Value = "My Text"
End If
Next
End Sub
Another way (Using Formulas in VBA). I guess this is the shortest VBA code as well?
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("B1:B" & lRow).Formula = "=If(A1<>"""",""My Text"","""")"
.Range("B1:B" & lRow).Value = .Range("B1:B" & lRow).Value
End With
End Sub
A simpler way to do this would be:
Sub populateB()
For Each Cel in Range("A1:A100")
If Cel.value <> "" Then Cel.Offset(0, 1).value = "Your Text"
Next
End Sub
Use the function IF :
=IF ( logical_test, value_if_true, value_if_false )
I have one file with two worksheets, both are full of names and addresses. I need a macro that will highlight rows in the first sheet if the cell A of that row does not match any rows from column A of the second sheet.
So if the first cell in a row has no matching data in any of the data in column A of sheet2 then that row is highlighted red.
Also I might want to expand this in the future so could I also specify that Sheet1 can be the active sheet, but sheet2 is called by the sheet name?
Try below code :
Sub Sample()
Dim lastRow As Integer
Dim rng As Range
lastRow = Sheets("Sheet1").Range("A65000").End(xlUp).Row
For i = 1 To lastRow
Set rng = Sheets("sheet2").Range("A:A").Find(Sheets("Sheet1").Cells(i, 1))
If rng Is Nothing Then
Sheets("Sheet1").Cells(i, 1).EntireRow.Interior.Color = vbRed
End If
Next
End Sub
Here's an ugly brute-force approach:
Dim r As Range
Dim s As Range
For Each r In ActiveSheet.UsedRange.Rows
For Each s In Sheets("Sheet2").UsedRange.Rows
If r.Cells(1, 1).Value = s.Cells(1, 1).Value Then
r.Interior.ColorIndex = 3
End If
Next s
Next r
Here's a slicker way:
Dim r As Range
Dim s As Range
Set s = Sheets("Sheet2").Columns(1)
For Each r In ActiveSheet.UsedRange.Rows
If Not (s.Find(r.Cells(1, 1).Value) Is Nothing) Then
r.Interior.ColorIndex = 3
End If
Next r
how about this:
Sub CondFormatting()
Range("D1:D" & Range("A1").End(xlDown).Row).Formula = "=IF(ISERROR(VLOOKUP(A:A,Sheet2!A:A,1,FALSE)),""NOT FOUND"",VLOOKUP(A:A,Sheet2!A:A,1,FALSE))"
With Columns("D:D")
.FormatConditions.Delete
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=""NOT FOUND"""
.FormatConditions(1).Interior.ColorIndex = 3
End With
Range("I16").Select
End Sub
here is an approach using a Worksheet formula:
=IF(ISERROR(VLOOKUP(A:A,Sheet2!A:A,1,FALSE)),"NOT FOUND",VLOOKUP(A:A,Sheet2!A:A,1,FALSE))
then you would use Conditional formatting to turn the cells red if column A doesn't find a match!
HTH
Philip