Im trying to check if records in one column of the table matches atleast one value of the ArrayList and if yes show those records who match in the next form
I have ArrayList full of strings and i dont know how to check and insert records from table to textboxes in next form, where atleast one of the records data of one column matches one value in ArrayList.
This doesn't work:
Public Sub Command42_Click()
Dim NotTrained As ArrayList
Set NotTrained = New ArrayList
NotTrained.Add "value1"
NotTrained.Add "value2"
DoCmd.OpenForm "form_name", WhereCondition:=NotTrained.Contains(handover_No) = True
End Sub
I dont know if i am even able to do this in WhereCondition, or i need to open the next form and insert the data in the textboxes in the NextForm.Load() Sub.
In the next form the textboxes have source control set to the columns in the table from which i want the records to be taken.
Part of the solution is :
You can loop through the range cells and look for existing ones in the Arraylist like this
Public Sub Command42_Click()
Dim NotTrained As ArrayList
Set NotTrained = New ArrayList
Dim I As Long, LR As Long
Dim rng As Range
NotTrained.Add "value1"
NotTrained.Add "value2"
LR = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
Set rng = Range("A1")
For I = 0 To LR
If NotTrained.IndexOf(rng.Offset(I, 0).Value, 0) = -1 Then
' the value is not in ArrayList
' Do Something
Else
' the value is in ArrayList
' Do Something Else
End If
Next I
'DoCmd.OpenForm "form_name", WhereCondition:=NotTrained.Contains(handover_No) = True
End Sub
I do not know what the structure of your form is, so I can not advise you how to fill it out.
Related
I have a template with a set number of columns (170) and title headers (row 1 cell name's). This is always the same, until users add columns in between (they're instructed not to change headers). The idea is to make it tamperproof as far as the adding of columns is involved.
I'd like to make variables to hold some of the headers (with the capacity to hold all) and check these with the template to find out the column number (in a loop I reckon). It's probably wisest to make a function to call upon it?
Dim ColHeader1Str as string 'literal row 1, column 1 value (which is always
'the same string and position in the template)
Dim iColHeader1 as integer 'holds the (to be set) value of the column number
Set ColHeader1Str = "ColHeader1"
Now I'd like a loop where it loops trough all the columns (last column = 200) and checks to see what the column number is that matches the ColHeader1Str and store this in the iColHeader1
So something like:
Function find_columnNmbr
Dim i As Integer
For i = 1 To 200 Step 1
If 'ColHeader1Str matches actual column header name
'set found integer as iColHeader1 and so forth
Exit For
End If
Next
End Function`
I know I'm missing a few steps and I'm hoping you guys can help me out.
Update: The template has set column headers. When users interact with it a result could be that columns shift position, or they add more. I have a workbook that needs to load data out of the user's altered template.
I.E. The template has columns 1, 2, 3, 4 and the names are column1, column 2 etc. A user ads a random column so now there are 5. The loop needs to loop through the names of the column headers and identify the column number of the original template columns 1, 2 etc based on a string variable with the original names, which I've hard coded beforehand. These are public constants.
What function LookForHeaders do: input a string, then search for the string in usersheet.range(1:1). If it is found, return the column number of that cell, otherwise it returns 0.
Private Function LookForHeaders(ByVal headerName As String) As Long
Dim rng As Range
Dim userSheet As WorkSheet
Set userSheet = 'userSheet here'
On Error GoTo NotFound
LookForHeaders = userSheet.Range("1:1").Find(headerName).Column
Exit Function
NotFound:
LookForHeaders = 0
End Function
Private Sub Test()
Dim rng As Range
Dim template As WorkSheet
Set template = 'template here'
For Each rng In template.Range(Cells(1,1), Cells(1,200))
iColHeader1 = LookForHeaders(rng.Value)
'Do something with iColHeader1
Next rng
End Sub
Not sure what your looking for but here is example
Option Explicit
Public Sub Example()
Dim LastCol As Long
Dim i As Long
LastCol = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column
For i = 1 To LastCol
If Cells(i) = "Name" Then
Debug.Print Cells(i).Address
End If
Next
End Sub
i have a simple Excel/VBA problem:
What i want to create is a (single-select) ListBox where I want to show unique values of Data i have on a different worksheet.
So far I have a ListBox like this:
And a named selection of the data i want to show:
I used a formula like this and used that as the input for the ListBox.
The formula: =BEREICH.VERSCHIEBEN(TopicData!$C$1;1;0;ANZAHL2(TopicData!$C:$C)-1;1)
Now my question is: How can i get the ListBox to show only unique values? I am familiar with vba, so a solution including this would be totally fine. In fact I already tried to remove duplicate entries in vba, whenever there is a change to the ListBox, but for some reason nothing seems to work.
Here is my vba script where I tried to solve this:
unfortunatley I always get a "Error 400" when I trie to call RemoveItem on the ListBox.
' ...
' filter listbox content so only unique values remain
Dim i As Integer
' find duplicates
Dim inList As New Collection
Dim indexesToRemove As New Collection
For i = availableTopicsListBox.ListCount - 1 To 1 Step -1
If CollectionContains(inList, availableTopicsListBox.List(i)) Then
' if it is already in the list, remove it
indexesToRemove.Add i
Else
inList.Add availableTopicsListBox.List(i)
End If
Next i
' remove duplicates
Dim j As Integer
For j = indexesToRemove.count To 1 Step -1
availableTopicsListBox.RemoveItem (indexesToRemove(j))
Next j
'...
The code below will use the Dictionary to store only unique values from column C (in "TopicData" worksheet), and then populate availableTopicsListBox listbox with only the unique values inside the Dictionary.
Code
Option Explicit
Private Sub UserForm_Activate()
Dim Dict As Object
Dim Key As Variant
Dim LastRow As Long
Dim C As Range
With Sheets("TopicData") '<-- I think this is your sheet's name
' find last row with data in column "C"
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
Set Dict = CreateObject("Scripting.Dictionary")
For Each C In .Range("C1:C" & LastRow)
If C.Value <> "" Then ' <-- skip empty cells
If Not Dict.exists(C.Value) Then
Dict.Add C.Value, 1
End If
End If
Next C
End With
' loop through all unique keys, and add them to the listbox
For Each Key In Dict.keys
availableTopicsListBox.AddItem Key
Next Key
End Sub
Context:
I have several lists in my sheet (1 column wide, 1-10 rows long). When I right click a cell in these lists, I can do several options, that all work well. I have given a name to the cell at the top of each of these lists (ex. Cell A1 has been given the name cell_1, B10 is names cell_2, etc).
I would like to know if the cell I am right clicking on is the one at the top of the list; is it named "cell_(number)"? If it is not, it checks the cell on top of that one. Does it have a name that starts with "cell_"? If not, check the one on top, etc. Until I can figure out the user clicked on an element of WHICH list.
TL;DR The actual question
I can use ActiveCell.Address, which gives me something like "A1" whether or not I have assigned a name to that cell. ActiveCell.Name gives "Sheet1!A1", so it's not much better. Any idea how to get it to return the name I have assigned instead?
Create a UDF to test the application names, it's less efficient but contains error handling within the function itself:
Sub SO()
'// Example how to call function
Debug.Print GetCellName(Range("A1"))
End Sub
Function GetCellName(myCell As Excel.Range) As Variant
Dim nameCheck As Variant
For Each nameCheck In Application.Names
If Replace(Replace(Replace(nameCheck, "=", ""), "'", ""), "!", "") = _
CStr(myCell.Parent.Name & myCell.Address) Then
GetCellName = CStr(nameCheck.Name)
Exit Function
End If
Next
GetCellName = CVErr(Excel.xlErrName)
End Function
Note you can also use this function in a worksheet cell like so:
=GetCellName(A1)
Perhaps this would work. This function returns the names assigned to a cell (or bigger range for that matter). If there's more than one name, it returns it as an array for array formula...or the user can supply an index to return only the desired name position
Public Function CellIsInRangeNames(sheetname As String, checkRange As Range, Optional itemNumber As Variant) As Variant
Dim oNM As Name
Dim oSht As Worksheet
Dim isect As Range
Dim namesCollection() As Variant
Set oSht = Worksheets(sheetname)
Dim i As Integer
i = -1
For Each oNM In oSht.Names
Set isect = Application.Intersect(Range(oNM.Name), checkRange)
If Not isect Is Nothing Then
i = i + 1
ReDim Preserve namesCollection(0 To i)
namesCollection(i) = CStr(oNM.Name)
End If
Next oNM
If i = -1 Then
'didn't find any
CellIsInRangeNames = xlErrName
ElseIf Not IsMissing(itemNumber) Then
'user wanted this instance only
If (itemNumber - 1 > UBound(namesCollection)) Or (itemNumber - 1 < LBound(namesCollection)) Then
CellIsInRangeNames = xlErrValue
Else
CellIsInRangeNames = namesCollection(itemNumber - 1)
End If
Else 'here's the list as an array
CellIsInRangeNames = namesCollection
End If
End Function
I have the need to execute some VBA code when a sheet changes. For this I have an If-then-else situation.
In any particular row (I have a variable number of rows (i.e. line items)):
if column "Type" = Range("A") then
column "Amount" needs to be unlocked
set to the value of Range("B") and locked
else if column "Type" = Range("C") then
column "Amount" needs to be unlocked
set to the value of Range("C") and locked
else
the column "Amount" needs to unlocked.
In the worksheet change event, I unlock/lock using ActiveSheet.Protect and .Unprotect with a password from a range.
I am now trying to figure out how to do this. Specifically, how do I use the column names - like in formula's?
=== for Excel 2007+ ===
If you are using Excel 2007+, I recommend using ListObject, ListColumns and ListRows (study the object model).
Philosophy behind my approach:
Forms, Data and Reports should always be separated, so...
Gather all your data into a Table, in a dedicated sheet. Select your data and Ctrl+(T or L). Make sure every sheet has only 1 table of data.
Using Tables, you'll be able to make use of the ListObject, ListColumns and ListRows objects.
Here's the finished code for the entire thing.
Public Sub test()
IntersectColumnRows ActiveSheet, "", "Type", "Amount", Range("A1"), Range("B1"), Range("C1")
End Sub
Public Sub IntersectColumnRows(currentSheet As Worksheet, sheetPassword As String, columnTitle_Type As String, columnTitle_Amount As String, rangeA As Range, rangeB As Range, rangeC As Range)
'variable declaration
Dim listO As ListObject
Set listO = currentSheet.ListObjects(1)
'Takes care of sheet protection
Dim isSheetProtected As Boolean
isSheetProtected = currentSheet.ProtectionMode
If isSheetProtected Then _
currentSheet.Unprotect (sheetPassword)
'store your type column
Dim columnRangeType As Range
Set columnRangeType = listO.ListColumns(columnTitle_Type).Range
'store your 2nd column
Dim columnRangeAmount As Range
Set columnRangeAmount = listO.ListColumns(columnTitle_Amount).Range
'the actual routine you are asking for
Dim listR As ListRow
For Each listR In listO.ListRows
'intersect the TYPE column with the current row
Dim typeRangeIntersection As Range
Set typeRangeIntersection = Application.Intersect(listR.Range, columnRangeType)
'intersect the AMOUNT column with the current row
Dim amountRangeIntersection As Range
Set amountRangeIntersection = Application.Intersect(listR.Range, columnRangeAmount)
'the logic you required
If typeRangeIntersection.Value = rangeA.Value Then
amountRangeIntersection.Locked = False
amountRangeIntersection.Value = rangeB.Value
amountRangeIntersection.Locked = True
ElseIf typeRangeIntersection.Value = rangeC.Value Then
amountRangeIntersection.Locked = False
amountRangeIntersection.Value = rangeC.Value
amountRangeIntersection.Locked = True
Else
amountRangeIntersection.Locked = False
End If
Next
'Cleans up sheet protection
If isSheetProtected Then _
currentSheet.Protect (sheetPassword)
End Sub
Here's the "how-I-did-it":
Store the ListColumn.Range for all required columns (Type, Amount)
For-loop with every ListRow...
I intersect the ListRow.Range with the ListColumn.Range
Apply your desired logic
Beyond the code, study how...
I included the PROTECT/PASSWORD logic in there, so you can remove it if you want to.
Each variable has a very explicit name
I didn't include any hard-coded value so it remains parametric, if you need to adapt some stuff for different sheets
I an trying to extract data from sheet "Record" by matching an entered reference number in sheet "Form" with those numbers in column B of "Record." I was able to come up with the VB code below through command button click. However, it will only return a single value from sheet "Record" column i and coding for each will really be time consuming.
Private Sub CommandButton1_Click()
With Application.WorksheetFunction
Sheets("Form").Range("b:b") = _
.Index(Sheets("Record").Range("h:h"), .Match(Sheets("Form").Range("i13"), Sheets("Record").Range("b:b"), 0), 1)
End With
End Sub
I'm wondering if is it possible to copy values from sheet "Record" columns H-Q to sheet "Form" columns B-K if the reference number in cell I13 of sheet "Form" matches any value on column B of sheet "Record?" Because what i encounter most of the time is returning the entire row.
I would really appreciate any help. Thanks
It might be brute force, but I think the best way is to loop through the data like this:
'Find the last row of data
Public Function Get_Last_Row_Find(ByVal rngToCheck As Range) As Long
Dim rngLast As Range
Set rngLast = rngToCheck.Find(what:="*", searchorder:=xlByRows, SearchDirection:=xlPrevious)
If rngLast Is Nothing Then
Get_Last_Row_Find = rngToCheck.Row
Else
Get_Last_Row_Find = rngLast.Row
End If
If Get_Last_Row_Find <= 1 Then
Get_Last_Row_Find = 2
End If
End Function
Public Sub CommandButton1_Click
x = Get_Last_Row_Find(Sheets("Record").Range("B:B")
for i = 1 to x
if Sheets("Form").Range("I13").Value = Sheets("Record").Range("B:B").Offset(i-1,0).Value then 'match
Worksheets("Record").Range("H"&i&":Q"&i).Copy _
destination:=Worksheets("Form").Range("B"&i&":K"&i)
next i
Note the two methods of "offsetting": you can use the .Offset method or you can use a variable and concatenate it within the Range("") text.
Code not tested.