In Access 2016 I have a multi-select listbox with a single column :-
Item 1
Item 1
Item 2
item 3
Item 3
In VBA, is there a way that I can remove duplicates from selected rows and display the remaining values in a message box. So, the following values would be displayed from the data above (assuming all rows are selected) :-
Item 1
Item 2
item 3
Use a dictionary and check for duplicates before adding new item
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
For lngRow = 0 To ListBox.ListCount - 1
If .Selected(lngRow) Then
If Not dict.exists(ListBox.Column(0, lngRow)) Then
x.Add ListBox.Column(0, lngRow), ""
End If
Next
For Each x In dict.keys
Str = Str & x & vbNewLine
Next
MsgBox Str
Related
I have two cascading lookup table comboboxes on a Datasheet form.(SessionCategories - SessionTypes). I'm having the following problems:
1) When the form loads I only see the values from the SessionTypes that correspond to the first SessionCategories ID.
2) When I change a value on the SessionCategories combo, all the SessionTypes values change across the datasheet and not only the selected.
Any ideas? Do I need to include something on the Form Load? More info and a couple of different approaches below.
Thanks.
ATHLETE_SESSION table
sessionOverviewID
sessionTypeID
SESSION_CATEGORIES
sessionOverviewID sessionOverview
1 aerobic
2 anaerobic
SESSION_TYPE
sessionTypeID sessionType sessionOverviewID
1 anaerobic1 2
2 anaerobic2 2
3 anaerobic3 2
4 aerobic1 1
5 aerobic2 1
6 aerobic3 1
sessionCategoriesID lookup properties:
Display control: Combo Box
Row Source Type: Table/Query
Row Source: SessionCategories
Bound Column: 1
Column Count: 2
Column Widths: 0cm;2cm
sessionTypeID lookup properties:
Display control: Combo Box
Row Source Type: Table/Query
Row Source:
Bound Column: 1
Column Count: 2
Column Widths: 0cm;2cm
1st approach:
Private Sub comboSessionCategories_AfterUpdate()
Dim strSQL As String
strSQL = "SELECT SessionType.sessionTypeID, SessionType.sessionType FROM SessionType WHERE (((SessionType.sessionOverviewID)=" & [Forms]![Session]![comboSessionOverview] & "))"
Me.comboSessionType.RowSource = strSQL
End Sub
2nd approach:
Private Sub comboSessionCategories_AfterUpdate()
Me.comboSessionType.RowSource = "SELECT SessionType.sessionTypeID, SessionType.sessionType" & _
" FROM SessionType WHERE SessionType.sessionOverviewID=" & Me.comboSessionOverview
Me.comboSessionType = Me.comboSessionType.ItemData(0)
End Sub
I am working on exporting CSVs of large groups from an active directory environment. Many of these groups have extensive nesting and I need to insert cells so that the worksheet is human readable.
For example my worksheet looks like this:
WS Example
Int User Path
0 User1 CN
0 User2 CN
1 User3 CN
1 User4 CN
0 User5 CN
1 User6 CN
2 User7 CN
I am looking for help adapting a VBA script that reads the integer value from the first column and inserts the corresponding number of cells to the left of the column for that particular row. The constraint is that the list cannot change the order of the rows so as to preserve the nested structure.
Here is what I have in VBA so far
Sub test()
Dim d As Integer
d = Range("A:A").End(xlDown).row
Dim c As Range
For i = d To 1 Step -1
If Cells(i, 1).Value Like "1" Then
Rows(Cells(i, 1).Column).Insert shift:=xlShiftRight
End If
Next
End Sub
Currently this snippet counts the number of 1's from the column and inserts a new row at the top of the list. I believe the error in my logic is within the If statement and once I have that ironed out I know I can expand that with an ElseIf to address the rest of the values.
This will do it. The issue looks like it's within the line Rows(Cells(i, 1).Column).Insert shift:=xlShiftRight. If you break that down, it computes as follows:
Cells(i,1).Column which equals 1, since the column of .Cells(i,1) is 1.
Rows(1) the 1 comes from the above. So Rows(1) is 1.
Rows(1).Insert inserts above row 1, regardless of what you specify for shift.
Sub test()
Dim d As Integer
d = Range("A:A").End(xlDown).row
Dim c As Range
For i = d To 1 Step -1
If Cells(i, 1).Value Like "1" Then
Cells(i, 1).Insert shift:=xlToRight
End If
Next
End Sub
This should do it.
Sub test()
Dim d As Integer
d = Range("A:A").End(xlDown).Row
Dim c As Range
For i = d To 1 Step -1
aMove = Val(Cells(i, 1))
If aMove > 0 Then
Range(Cells(i, 1), Cells(i, aMove)).Insert shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
End If
Next
End Sub
Quite a few ways to do this, but by using the number in columnA to define the amount of cells to insert you can do a second loop like so:
Private Sub CommandButton1_Click()
Dim x, d, i As Integer
With ActiveSheet
d = .Range("A:A").End(xlDown).Row
For x = 2 To d
i = .Cells(x, 1).Value
For a = 1 To i
.Cells(x, 1).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Next a
Next x
End With
End Sub
Is it possible to add multiple data that has been selected from a subform to the main form?
Form.SelTop and .SelHeight are the key properties here.
Example with a subform.RecordsetClone loop:
Set F = Me.Subform.Form
Set RS = F.RecordsetClone
RS.MoveFirst
' goto first selected record
RS.Move F.SelTop - 1
' loop over all selected records
For i = 1 To F.SelHeight
' do something with fields from RS
RS.MoveNext
Next i
To select data it is better to use a listfield
and then copy the data with a VB program in the table:
set rs1=currendb.openrecordset ("NAME OF TABLE)
For Z = 0 To Me.ListField.ListCount - 1
If Me.ListField.Selected(Z) = True Then
Rs1.addnew
rs1!field1 = Me.LisField.Column(0, Z)
rs1!field2 = Me.LisField.Column(1, Z)
End If
next z
Hello Everyone I am at a dilemma I am trying to find out a way to filter out certain data in a column field I have an idea on how to do this but I do not know the correct syntax to use. First here is the table and here is the code structure I would like to write.
for i=1 to length of column First Match
for j=1 to length of column Second Match
If ((value of the data in column First Match = 15) OR (value of the data in column FirstMatch = 1)) AND
((value of the data in column Second Match = 15) OR (value of the data in column Second Match = 1))
Then
Filter the data and append so the filtered datas are saved for both First Match and Second Match
end if
next
next
I am trying to filter out the data that is a 15 and 1 so that only data that have the values 0,2,3,4,5,6...14 will be shown for instance the information of john and steve will not be shown because both the first and second match fields have a 1 or 15 but the rest of data will be shown my form is a split form setup.
Is my method correct?
First Name Last Name First Match Second Match
James Matheson 0 2
Monroe Labonson 4 3
Barack Obama 2 5
Frederick Douglas 3 4
Steve MCGowan 1 1
John Seals 15 15
Mike Omalley 14 15
Set rs = CurrentDb.OpenRecordset("Table1")
Do While Not rs.EOF
If rs!Fields("First Match") > 1 And rs!Fields("First Match") < 15 And rs!Fields("Second Match") > 1 And rs!Fields("Second Match") < 15 Then
End If
Loop
With a better understanding (I hope) I've reproduced your data in Access and built a query that does what you seem to ask. The best way to see this is to create a new query, not add a table, and go directly to SQL view. Paste the following SQL statement (the one in quotes) in and replace matchFilter with your table name.
In your event code you can create a recordset based on the SQL:
Dim sSQL as string, rs as Recordset
sSQL = "SELECT matchFilter.[First Name], matchFilter.[Last Name], matchFilter.[First Match], matchFilter.[Second Match] " & _
"FROM matchFilter " & _
"WHERE ((([First Match]<>1 And [First Match]<>15 And [Second Match]<>1 And [Second Match]<>15)=True))"
Set rs = CurrentDB.OpenRecordset(sSQL)
' now do what you want
Wrong answer below!
Dim rs as Recordset
Set rs = CurrentDB.OpenRecordset("yourTableName")
Do While Not rs.EOF
If rs!Fields("col1") > 1 AND rs!Fields("col1") < 15 AND rs!Fields("col2") > 1 AND rs!Fields("col2") Then
'do what you have to do with filtered out records
End If
Loop
I have found the solution apparently it was just a misunderstanding because the first time I tried this code I thought it was wrong but it was because my field names did not have spaces in between the first time I wrote them.
Me.Filter = ""
Me.Filter = "[First Nam]<>'Jamie' AND [Last Nam]<>'Cartman'"
Me.FilterOn = True
This problem is in an Excel .xls file.
Simplest Use Case:
Column A has one row.
Column B has 5 rows.
The 5 rows in Column B need to be merged into one row, delimited by newlines.
I have a huge .xls document where there are a ton of IDs in column A.
There are on average anywhere from 3 to 10 rows that belong to each column A row.
How to know which Column B rows belong to which Column A?
By the positioning of the cells.
One Column A row may have 5 Column B rows to the right of it.
I don't have any VBA experience.
I have looked around for macros and functions but haven't had any luck finding anything that matches this problem.
Edit:
I am now trying to figure out how to get the script to ignore rows that have a one-to-one mapping between column A and column B.
Edit again - 06-20-2012:
Now that I can attach images, here is a screenshot of an image for what I'm trying to get.
The rows for Brian and Mark should be ignored, while Scott and Tim get their values copied over.
Edit:
Unmerging column A, using the code that Andy supplied, and then using this VB script afterwards does the trick:
Sub mergeA()
For i = 2 To Cells(65535, 1).End(xlUp).Row
If IsEmpty(Cells(i, 1)) Then Range(Cells(i - 1, 1), Cells(i, 1)).Merge
Next
End Sub
That VB script puts the cells in column A back together
I didn't make the script, it came from this web page:
http://www.vbforums.com/showthread.php?t=601304
This will transform the data shown on the left to the output on the right:
Option Explicit
Sub Make_Severely_Denormalized()
Const HEADER_ROWS As Long = 1
Const OUTPUT_TO_COLUMN As Long = 3
Const DELIMITER As String = vbNewLine
Dim A_Range As Range
Dim B_Range As Range
Dim A_temp As Range
Dim B_temp As Range
Dim B_Cell As Range
Dim Concat As String
On Error GoTo Whoops
Set A_Range = Range("A1").Offset(HEADER_ROWS)
Do While Not A_Range Is Nothing
Set B_Range = A_Range.Offset(0, 1)
' some helper ranges
If A_Range.Offset(1, 0).Value = "" Then
Set A_temp = Range(A_Range, A_Range.End(xlDown).Offset(-1, 0))
Else
Set A_temp = A_Range.Offset(1, 0)
End If
Set B_temp = Range(B_Range, B_Range.End(xlDown)).Offset(0, -1)
' determine how high "B" is WRT no change in "A"
Set B_Range = Range(B_Range, B_Range.Resize( _
Application.Intersect(A_temp, B_temp, ActiveSheet.UsedRange).Count))
' loop through "B" and build up the string
Concat = ""
For Each B_Cell In B_Range
Concat = Concat & B_Cell.Value & DELIMITER
Next
Concat = Left(Concat, Len(Concat) - Len(DELIMITER))
' do the needful
A_Range.Offset(0, OUTPUT_TO_COLUMN - 1).Value = Concat
' find the next change in "A"
If A_Range.Offset(1, 0).Value = "" Then
Set A_Range = Application.Intersect(A_Range.End(xlDown), ActiveSheet.UsedRange)
Else
Set A_Range = A_Range.Offset(1, 0)
End If
Loop
Exit Sub
Whoops:
MsgBox (Err & " " & Error)
Stop
Resume Next
End Sub