I have 2 tables "A" and "B" in an Access Database.
There's a column in A called "AID" with an ID number, and there's a column in B called "BID" with an ID number.
Also, there's a column in A called "OBE" (for obsolete). OBE is a boolean True/False data type.
I want to write a VBA procedure that iterates through each ID number in AID and checks if it exist in BID. If an ID number in AID doesn't exist in BID, I want OBE to be set to "True" for that row.
I plan to implement this code into a button on a form.
I think I have the right idea below but I am unfamiliar with VBA/Access syntax.
Edit (additional context):
One of the reasons why I have it as arrays is because BID isn't just an ID, it's a long title that contains the ID somewhere inside of it. The ID exists somewhere in BID after a sequence of words, so basically I was planning to additionally use the "left()" and "right()" functions, pin-pointing the ID, then creating each element of BID_array one-by-one in a for-loop.
Public Function
dim AID_array as array
dim BID_array as array
dim AID_length as integer
dim BID_length as integer
isin as boolean
AID_array = A.AID
BID_array = B.BID
AID_length = length(AID_array)
BID_length = length(BID_array)
for i = 1:AID_length
isin = false
for j = 1:BID_length
if AID_array(i) = BID_array(j) then
isin = true
endif
next j
if isin = false then
A.OBE(i) = true
end if
next i
End Function
Try this procedure:
Private Sub cmdTesting_Click()
Dim rst As Recordset
Dim sql As String
Set rst = CurrentDb.OpenRecordset("Select * from A Left Join B On A.AID = B.BID", dbOpenDynaset, dbInconsistent)
rst.MoveFirst
Do While Not (rst.EOF)
If IsNull(rst("BID")) Then
rst.Edit
rst("OBE") = True
rst.Update
End If
rst.MoveNext
Loop
End Sub
Related
I am writing some code in VBA in word and I would like to get the position of first borderline of the table as shown in this image
As seen in the above image, i would like to equalize the first table margin and second table margin (not sure if "margin" is the right word). The intention is to make the first table and second table column widths equal and combine them, merging them into one table. The word document has about 20 separate table and hence i would like to combine all of them into one single table. Please note that the empty tables that you see above has data removed to preserve confidential information.
What I have tried so far:
Public Sub CorrectTables()
Dim mainTable As Table
Dim secondTable As Table
Dim firstColWidth As Integer
Dim secondColumnWidth As Integer
Dim thirdColumnWidth As Integer
Dim fourthColumnWidth As Integer
Dim fiftColumnWidth As Integer
'Get current table
Set mainTable = ActiveDocument.Tables(1)
**firstColMarginPos = mainTable.LeftPadding** This is where i need some help to set the position
firstColWidth = mainTable.Columns(1).Width
secondColumnWidth = mainTable.Columns(2).Width
thirdColumnWidth = mainTable.Columns(3).Width
fourthColumnWidth = mainTable.Columns(4).Width
fiftColumnWidth = mainTable.Columns(5).Width
Dim currentTableCount As Integer
While ActiveDocument.Tables.Count <> 1
currentTableCount = ActiveDocument.Tables.Count
Set secondTable = ActiveDocument.Tables(2)
secondTable.LeftPadding = firstColMarginPos
secondTable.Columns(1).Width = firstColWidth
secondTable.Columns(2).Width = secondColumnWidth
secondTable.Columns(3).Width = thirdColumnWidth
secondTable.Columns(4).Width = fourthColumnWidth
secondTable.Columns(5).Width = fiftColumnWidth
Selection.Tables(1).Select
Selection.Collapse WdCollapseDirection.wdCollapseEnd
While (ActiveDocument.Tables.Count - currentTableCount = 0)
Selection.Delete Unit:=wdCharacter, Count:=1
Wend
Wend
End Sub
I figured out the answer. For the first table, i am able to get the indentation:
firstColMarginPos = mainTable.Rows.LeftIndent
Then i am able to use it to set the value for the second table:
secondTable.Rows.SetLeftIndent LeftIndent:=firstColMarginPos, RulerStyle:=wdAdjustFirstColumn
Please refer my image, So you may get id MY Data source field
ea about my question,
column A field have 20k values rows, I want to Create blank row after data move to column-wise,( blank rows count=column wise count)
please give me solution vb MY Data source field
VBA or any formula MY DATA SOURCE IMAGE
Try this code
Sub Test()
Dim myAreas As Areas
Dim i As Long
Dim c As Long
Application.ScreenUpdating = False
Set myAreas = Columns(1).SpecialCells(2, 1).Areas
c = 1
For i = 1 To myAreas.Count
c = c + 1
Cells(myAreas(i)(1).Row, c).Resize(myAreas(i).Count).Value = myAreas(i).Value
Next i
Application.ScreenUpdating = True
End Sub
I have a bunch of Variables I need to declare and was wondering if there's any way to shorten the amount of lines needed to do so. Here's the code:
Sub test()
dim comps as New Collection
dim noOfCompanies as Integer: noOfCompanies = 25
dim c1 as New Names 'Names is a class I have made
dim c2 as New Names
... ' in this gap is c3 to c29
dim c30 as New Names
End Sub
I don't know that you can create a variable and do something like the following, can you? (Note: Psuedocode)
dim i as Integer
for i = 1 to 30
Dim "c" & i as New Names
next i
edit:
#rene mentioned using an array - how would I do so, if later I'm going to set parts of the class properties (sorry, I'm learning classes and don't know the proper terms):
c1.companyCode = 10: c1.companyCountry = "USA": c1.companyName = "Batman LTD"
c2.companyCode = 13: c2.companyCountry = "Krypton": c2.companyName = "Superman LLC"
... 'etc until c30.
Here's what I'm trying so far, but to no avail:
Dim tempC As String, tempN As String
For i = 1 To noOfCompanies
c(i) = "c" & i
tempC = c(i)
Debug.Print tempC 'This will correctly print "c1", "c2", "c3", etc.
Dim c(i) As New Names 'This is where I can't figure out how to declare the different array parts as an individual "new Names" class part.
Debug.Print tempN
Next i
edit2:
Here's why I'm trying to create 30 variables. I get a spreadsheet every week that has a column of codes (the codes being that companyCode I am initializing above). If I find a row with any of the 30 codes I am trying to declare, then I need the companyName and companyCountry to be placed in some other cells on that row. My idea was to be able to just do something like this (psuedocode):
dim rng as Range
rng = Range("A1:A30") 'this has the codes in it, i.e. 13, 10, 11, 20...
for each cel in Rng
'here would be code where I just check for IF the cel.Value is anywhere in companyCode,
'return its equivalent companyCountry and companyName
next cel
So, would a dictionary be best? I could do like
if dict.exists(cel.value)
BUT how could I store the companyCountry and companyName in the same dictionary entry, AFAIK I can only store one key per entry?
...of course, if just saving this info in an excel table somewhere (xlsx or csv) and just opening/using that then closing would be best practice, just let me know!
Dim arrNames(1 to 30) as Names, n
for n=1 to 30
Set arrNames(n)=new Names
next n
arrNames(5).companyCountry = "USA"
EDIT: I think storing your code information on a worksheet and accessing it directly is the "best" approach unless you need high-volume/high-performance lookups (even then it will not be bad...)
For example here's a pretty simple function you can call from VBA:
Function CompanyInfo(companyCode, infoType As String)
Dim rng As Range, colNum As Long, rv
Select Case infoType
Case "Country": colNum = 2
Case "Name": colNum = 3
Case Else
CompanyInfo = "InfoType?"
Exit Function
End Select
rv = Application.VLookup(companyCode, _
ThisWorkbook.Sheets("Codes").Range("A2:C100"), _
colNum, False)
CompanyInfo = IIf(IsError(rv), "???", rv)
End Function
Usage:
Dim v, v2
v = CompanyInfo(10,"Country")
v2 = CompanyInfo(10,"Name")
Example using a collection to create 30 instances of a class containing the name.
If it is imperative that they be able to be retrieved using "c1-c30", then you can either use that as a variable in the class (like Name) or as the collection index/key.
For example:
Names Class:
Private pName As String
Private pOther As Integer
Public Property Get Name() As String
Name = pName
End Property
Public Property Let Name(Value As String)
pName = Value
End Property
Assigning and Printing our 30 Names:
Sub Test()
Dim MyNames As Collection
Set MyNames = New Collection
Dim x
For x = 1 To 30
Dim t As Names
Set t = New Names
t.Name = "c" & x
MyNames.Add t
Next x
Dim y
For Each y In MyNames
MsgBox (y.Name)
Next y
End Sub
In closing, I think your problem is that you want to be able to reference these 30 cnames in your code by name later after having assigned them. That's not going to work and it's a bad coding practice. You shouldn't do:
Dim c1
Set c1 = new Names
c1.Name = "Bob"
Dim c2 '...
There's a reason people don't typically declare 30 variables with incremental numbers. The reason is because there is a better way. That way is typically using a collection of variable types or an array of variable types that you can reference using an index or a loop.
If you're creating 30 instances of a certain data type, and you want to give them each unique values, create a table or even a static array to hold their values and assign them in a loop.
To follow up, if you want to reference them using c & x then add a variable to your class called ID and assign to that.
You might want to look into using a dictionary if you would like to be able to quickly retrieve the ID without looping through and checking ID's.
Edit:
I'm glad you explained your end game. You are absolutely over-complicating this scenario.
A simple VLOOKUP formula and a lookup table would save you from having to code anything in VBA at all.
Example:
Create a named range called LookupTable that contains the company ID's on the far left:
Then, use these formulas to search your table for the ID, and give you the name/location.
Parameter 1 is the value to Lookup
Parameter 2 is our LookupTable
Parameter 3 is the column from our table to return
(1 = ID, 2 = Company Name, 3 = City)
Parameter 4 says we want an exact match only.
=VLOOKUP(A1,LookupTable,2,FALSE)
I'm not sure if I like the use of "Names" as a class name since "Names" already has an Excel VBA meaning, but if that's what you want.
As others have pointed out, an array is probably the way to go. But if you really want to have 30 variables and you don't want to do a lot of typing, you can do something like this:
Sub DeclareVars()
Dim i As Long, v As Variant
ReDim v(1 To 30)
For i = 1 To 30
v(i) = "c" & i & " As New Names"
Next i
Debug.Print "Dim " & Join(v, ", ")
End Sub
Run it once and copy the result from the immediate window into your code. If you know Python you can use a 1-liner in the Python shell and type even less. Just evaluate:
"Dim " + ", ".join('c' + str(i) + " As New Names" for i in range(1,31))
Why don't you store your c1, ... c30 objects properties in a table, an xml file, a csv file, or any other of the multiple types of files? That can store data and be read via VBA.
So, when needed, you can just open the table, and populate an array of your object's properties with the values in the table? If your table/file contains 30 lines, an array of 30 objects will then be created.
By doing this, you will also separate your code from your data, which is usually considered as a best practise.
First question here. I was looking for a way to essentially compare 2 small data sets/tables and look for values in column a of table 1 that are additional or are not present in the 'master' table and include some message in a third column. This is in VBA.
It may be easier to explain what I'm hoping to get as output given 2 example tables.
Table 1 in columns a and b of Sheet1:
A B
a12 horse
b23 dog
f54 cat
Table 2 in columns a and b of Sheet2:
A B
b23 dog
f54 cat
i09 tiger
Desired output:
a12 horse Warning: This is an additional value not present in Table 2
b23 dog
f54 cat
i09 tiger Warning: This value was expected but not present in Table 1
Thanks for the help and let me know if there is additional detail can provide to make this easier to answer
Firstly be aware it is the same problem twice.
You essentially need to scan rows of table A to see if they are in table B. Where they are output the row, where only table A has the row output the row with a message.
So you would do this firstly using table 1 as table A, then again but using table 2 as table B. Adding the output of the second at the end of the first.
It's difficult to advise more without knowing more about your VBA ability.
Also your example provides two columns. Do both columns need to be compared or do you just need to compare one? I have assume both (worst case scenario).
You are really using the UNION set operator to add all unique rows so you might be able to adapt the method used here . You have to adapt it as you want the text that describes which table a row was unique to.
Alternatively, you could do it writing VBA loops which would be something like this (which I think will give you what you need).
Paste this into a new module and run Main(). You will need to define the sheet and ranges.
Option Explicit
Dim s1 As Worksheet
Dim s2 As Worksheet
Dim sOutput As Worksheet
Dim NextOutputRow As Range
Sub CompareTwoTables(TableA As Range, TableB As Range, NameOfTableB As String, OutputIfRowsMatch As Boolean)
Dim TableArow As Long
Dim TableBrow As Long
Dim TableACell As Range
Dim TableBCell As Range
Dim FoundMatchingRow As Boolean
Dim ColumnDifferencesDetected As Boolean
TableA.Parent.Select ' useful for debugging - selects teh sheet
For TableArow = 1 To TableA.Rows.Count
FoundMatchingRow = False
For TableBrow = 1 To TableB.Rows.Count
ColumnDifferencesDetected = False
Set TableACell = TableA.Cells(TableArow, 1)
Set TableBCell = TableB.Cells(TableBrow, 1)
TableACell.Select ' useful for debugging
Debug.Print TableACell.Address, TableBCell.Address ' useful for debugging
If TableACell.Value = TableBCell.Value Then
If TableA.Cells(TableArow, 2) = TableB.Cells(TableBrow, 2) Then
FoundMatchingRow = True
Else
ColumnDifferencesDetected = True
End If
End If
If FoundMatchingRow Or ColumnDifferencesDetected Then
Exit For ' TableBrow
End If
Next TableBrow
If FoundMatchingRow Then
If OutputIfRowsMatch Then
NextOutputRow.Cells(1, 1) = TableA.Cells(TableArow, 1)
NextOutputRow.Cells(1, 2) = TableA.Cells(TableArow, 2)
Set NextOutputRow = NextOutputRow.Offset(1, 0)
End If
ElseIf ColumnDifferencesDetected Then
NextOutputRow.Cells(1, 1) = TableA.Cells(TableArow, 1)
NextOutputRow.Cells(1, 2) = TableA.Cells(TableArow, 2)
NextOutputRow.Cells(1, 2) = "One only one column was the same"
Set NextOutputRow = NextOutputRow.Offset(1, 0)
Else
NextOutputRow.Cells(1, 1) = TableA.Cells(TableArow, 1)
NextOutputRow.Cells(1, 2) = TableA.Cells(TableArow, 2)
NextOutputRow.Cells(1, 3) = "This value was expected but not present in " & NameOfTableB
Set NextOutputRow = NextOutputRow.Offset(1, 0)
End If
Next TableArow
End Sub
Sub main()
Dim Table1 As Range
Dim Table2 As Range
' Three sheets must exist
Set s1 = Worksheets("Sheet1")
Set s2 = Worksheets("Sheet2")
Set sOutput = Worksheets("Sheet3")
Set Table1 = s1.Range("A2:B10") ' Allows for a title row and two columns
Set Table2 = s2.Range("A2:B10")
' Clear any previous output
sOutput.Cells.ClearContents
Set NextOutputRow = sOutput.Range("2:2") ' Allows for a title row
CompareTwoTables TableA:=Table1, TableB:=Table2, NameOfTableB:="Table2", OutputIfRowsMatch:=True
CompareTwoTables TableA:=Table2, TableB:=Table1, NameOfTableB:="Table1", OutputIfRowsMatch:=False
sOutput.Select
MsgBox "Done"
End Sub
I have a recordset from en SQL server. I don't know the exact amount of data I need to retrieve, hence I have created a dynamic array.
What I need to do, is to seperate and sort data when I put it in the array. But I don't know what best practice on this will be.
E.g. I have set of data with a customer ID in one column and revenue in the second. Lets say I only have 2 customers and have a list like the one below:
Customer ID Revenue
1 604
2 669
2 732
2 629
1 897
2 530
I would then like my array to have two dimensions (customer 1 and 2) and have a maximum lenght that matches with the maximum amount of purchases one customer has made. In this case, customer 2 have made four purchases and customer 1 have made two. Therefore my ideal array would be something like this: myArray(1 to 2, 4).
How will I do this best?
Then after I have defined my array, I would like to populate it with my data, but the data is not sorted, so how can I determine in what place I should put the data next? If that makes sence?
For example my initial thought was to run through the dataset and do something like this:
i = 1
do until dataset.eof
if dataset.field("customerid") = 1 then
myArray(1, i) = dataset.field("customerid").value
else if dataset.field("customerid") = 2 then
myArray(1, i) = dataset.field("customerid").value
end if
i = i + 1
dataset.movenext
loop
This is all fine and dandy, until the customer ID changes. If the first to rows are customer 1 then the data would be placed in myArray(1, 1) and myArray(1, 2). But then if the customer ID on the next row i customer 2, the first entry for customer 2 will be in myArray(2, 3) and not in myArray(2, 1) as I will desire.
Also with this, I will exceed the limits of the array if I have the array defined as per my first question :-)
Does this all make sense?
Thanks in advance :-)
You can use a scripting dictionary with the customer id as the key and an array of revenues as the value.
Untested:
dim dict as object, id, rev, tmp, k
set dict = createobject("scripting.dictionary")
do until dataset.eof
id = dataset.fields("customerid").Value
rev = dataset.fields("revenue").Value
if dict.exists(id) then
tmp = dict(id)
ub = ubound(tmp)+1
redim preserve tmp(0 to ub)
tmp(ub) = rev
dict(id) = tmp
else
dict(id) = Array(rev)
end if
dataset.movenext
loop
for each k in dict
debug.print k, join(dict(k),", ")
next k
I believe that arrays are not the best data structure for this goal. I would use a collection of classes. That gives great flexibility in both storing and sorting data. As an example, I created the following:
-in the worksheet (as data source, to replace your recordset):
-Code module Module1:
Option Explicit
Sub jzz()
Dim Customers As Collection
Dim cust As cls_customer
Dim i As Long
Dim arr() As Long
Set Customers = New Collection
i = 1
Do Until Cells(i, 1) = vbNullString
'check if the customer is already in the collection:'
For Each cust In Customers
If cust.id = Cells(i, 1) Then Exit For
Next cust
'check if the customer was found; if not, create new and add to collection'
If cust Is Nothing Then
Set cust = New cls_customer
cust.id = Cells(i, 1)
Customers.Add cust
End If
cust.Revenue = Cells(i, 2)
i = i + 1
Loop
For Each cust In Customers
Debug.Print cust.id, cust.Revenue_count
Next cust
Set Customers = Nothing
End Sub
-Class module cls_customer:
Option Explicit
Public id As Long
Private p_revenue_collection As Collection
Public Property Let Revenue(value As Long)
'accepts a long (value) and adds it to the collection'
p_revenue_collection.Add value
End Property
Public Property Get Revenue_count() As Long
Revenue_count = p_revenue_collection.Count
End Property
Private Sub Class_Initialize()
Set p_revenue_collection = New Collection
End Sub
The class holds only the revenue_count property, which returns the amount of entries in the collection, but you can add your own properties at will to return sorted data etc.