Solved

VBScript, Comparing Excel Columns

Posted on 2007-04-04
24
939 Views
Last Modified: 2011-10-03
Hi all,
I am working on a script to compare columns (each column will pull data from a different source).
Column A - AD SN
Column B - AD GivenName
Column C - AD Description

My question is - I am going to have COLUMN D pull from SQL, but right now trying this out w/ AD, which will only pull from one OU, rather than all..... Here is the script
________________________________________________

Option Explicit

Dim dtmDate, strMonth, strYear, strFileName, strLast_Name, StrFirst_Name, j, sites, site, i, objExcel, objRangeQRY, objRange3, objWorkbook, objWorksheet1, objWorksheet2, objSearch, objRange, objRange2, objContainer, objChild

Const xlAscending = 1
Const xlYes = 1

dtmDate = Date
strMonth = Month(Date)
strYear = Year(Date)

strFileName = "C:\" & "Month_End_" & strMonth & "-" & strYear & ".xls"
'Names XLS file

Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Add
'sets objWorkbook to use Excel.Workbooks.Add function
Set objWorksheet1 = objWorkBook.WorkSheets(1)
'sets the name objWorksheet1 to Excel.Application.Workbooks.Worksheets(1)
objExcel.Visible = True

objExcel.ActiveSheet.Name = "JSC_Users"                  'names Active Sheet
objExcel.ActiveSheet.Range("A1").Activate                  'Selects A1
objWorkSheet1.Cells(1, 1).Value = "Last_Name"                  'col header 1
objWorkSheet1.Cells(1, 2).Value = "First_Name"                  'col header 2
objWorkSheet1.Cells(1, 3).Value = "Description"                  'col header 3
objWorkSheet1.Cells(1, 4).Value = "Assentor_Last_Name"            'col header 4
objWorkSheet1.Cells(1, 5).Value = "Assentor_First_Name"            'col header 5
objExcel.ActiveCell.Offset(1,0).Activate                        'move 1 down


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Sets Sites, Pulls in Last,First Names to Column A
sites=Array("OU=New Jersey","OU=Long Island", "OU=NYC")

For Each site in sites
  Set objContainer = GetObject("LDAP://" & site & ",DC=JSC,DC=COM")
  objContainer.Filter = Array("user")
  For Each objChild In objContainer
      If objChild.SN <> "" And Len(objChild.SN) > 2 Then 'Test for non-blank and greater than 2 characters in the SN property
        objExcel.ActiveCell.Value = objChild.SN
        objExcel.ActiveCell.Offset(0,1).Value = objChild.GivenName
        objExcel.ActiveCell.Offset(0,2).Value = objChild.Description
        objExcel.ActiveCell.Offset(1,0).Activate                  'move 1 down
      End If
  Next
Next
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''End Sites

set objRange = objWorksheet1.UsedRange
set objRange2 = objExcel.Range("A1")

objRange.Sort objRange2, xlAscending, , , , , , xlYes
'Sorts ALL used Cells by Column 1 (A1).  xlAscending, sorts ascending, xlYes means Header Row=Yes

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Imports First/Last Name from SQL
objExcel.ActiveSheet.Range("D2").Activate
Set objContainer = GetObject("LDAP://OU=Long Island,DC=JSC,DC=COM")

objContainer.Filter = Array("user")
For Each objChild In objContainer
      objExcel.ActiveCell.Value = objChild.SN
      objExcel.ActiveCell.Offset(0,1).Value = objChild.GivenName
      objExcel.ActiveCell.Offset(1,0).Activate                  'move 1 down
Next

Set objContainer = GetObject("LDAP://OU=NYC,DC=JSC,DC=COM")

objContainer.Filter = Array("user")
For Each objChild In objContainer
      objExcel.ActiveCell.Value = objChild.SN
      objExcel.ActiveCell.Offset(0,1).Value = objChild.GivenName
      objExcel.ActiveCell.Offset(1,0).Activate                  'move 1 down
Next

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Auto Size Columns
objWorkSheet1.Columns.AutoFit()
'Autosize for Column Width for Work Sheet 1
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''End Auto Size Columns

'Set objRange3  = objExcel.Range("D2")
'objRange.Sort objRange3, xlAscending, , , , , , xlYes

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Compare
Set objRangeQRY = objWorksheet1.Range("D1").EntireColumn
i = 1
j = 1
Do Until objExcel.Cells(i, 1).Value = ""
    strLast_Name = objExcel.Cells(i, 1).Value
    strFirst_Name = objExcel.Cells(j, 2).Value
    Set objSearch = objRangeQRY.Find(strLast_Name)

    If objSearch Is Nothing Then
        Wscript.Echo strFirst_Name & " " & strLast_Name & " was not found."
    End If
    i = i + 1
    j = j + 1    
   Loop
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''End Compare




set objWorksheet2 = objWorkBook.WorkSheets(2)
objWorksheet2.Name = "Assentor Users"
objWorksheet2.activate                              'activates Assentor Users Work Sheet

Wscript.Echo "Comparison Complete"

objWorkBook.SaveAs(strFileName)
objExcel.Quit

_____________________________________________

As you can see the 'Comparison' is made by selecting the "D" Column, and having "strLast_Name" checked against it.
I some users that have the same last name.  Which is causing a problem.  If one user's SN is SMITH, and another is SM, I run into an issue where it appears 2x, even though it is not.  So it will come show me that it is not found.  Is there a way I can have my search do both first name, and last name when comparing?

Thanks,
G
0
Comment
Question by:jsctechy
  • 13
  • 11
24 Comments
 
LVL 67

Expert Comment

by:sirbounty
ID: 18853644
Have you no way to pull in the login name (samaccountname) property?
Those would need to be unique - last name, as you've found, doesn't have to be...
0
 
LVL 1

Author Comment

by:jsctechy
ID: 18857279
I can pull in login name, but the DB that AD login names will be compared to doesn't have login names.  They do not log into that SQL system.  Only common things between the two systems are
Last Name, First Name, and email address.  Now I can compare email addresses, however, AD emails are as follows :   "glandry@jsc.com" and in SQL DB they can be "glandry@jsc.com, glandry@messagelabs.com".  So maybe if done by email address, a search/filter can be applied to show 'within' rather than an exact match?
Got any ideas for me?
0
 
LVL 1

Author Comment

by:jsctechy
ID: 18858641
This is what I ended up doing-

_____________________________________
Option Explicit

Dim dtmDate, strMonth, strYear, strFileName, strLast_Name, StrFirst_Name, j, sites, site, i, objExcel, objRangeQRY, objRange3, objWorkbook, objWorksheet1, objWorksheet2, objSearch, objRange, objRange2, objContainer, objChild

Const xlAscending = 1
Const xlYes = 1

dtmDate = Date
strMonth = Month(Date)
strYear = Year(Date)

strFileName = "C:\Scripts\OutPut\" & "Month_End_" & strMonth & "-" & strYear & ".xls"
'Names XLS file

Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Add
'sets objWorkbook to use Excel.Workbooks.Add function
Set objWorksheet1 = objWorkBook.WorkSheets(1)
'sets the name objWorksheet1 to Excel.Application.Workbooks.Worksheets(1)
objExcel.Visible = True

objExcel.ActiveSheet.Name = "JSC_Users"                  'names Active Sheet
objExcel.ActiveSheet.Range("A1").Activate                  'Selects A1
objWorkSheet1.Cells(1, 1).Value = "Last_Name"                  'col header 1
objWorkSheet1.Cells(1, 2).Value = "First_Name"                  'col header 2
objWorkSheet1.Cells(1, 3).Value = "Description"                  'col header 3
objWorkSheet1.Cells(1, 4).Value = "AD_Email"                  'col header 4
objWorkSheet1.Cells(1, 5).Value = "Assentor_Last_Name"            'col header 5
objWorkSheet1.Cells(1, 6).Value = "Assentor_First_Name"            'col header 6
objExcel.ActiveCell.Offset(1,0).Activate                        'move 1 down


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Sets Sites, Pulls in Last,First Names to Column A
sites=Array("OU=New Jersey","OU=Long Island","OU=NYC","CN=Users","CN=BuiltIn")

For Each site in sites
  Set objContainer = GetObject("LDAP://" & site & ",DC=JSC,DC=COM")
  objContainer.Filter = Array("user")
  For Each objChild In objContainer
      If objChild.Mail <> "" And Len(objChild.Mail) > 2 Then 'Test for non-blank and greater than 2 characters in the Mail property
        objExcel.ActiveCell.Value = objChild.SN
        objExcel.ActiveCell.Offset(0,1).Value = objChild.GivenName
        objExcel.ActiveCell.Offset(0,2).Value = objChild.Description
        objExcel.ActiveCell.Offset(0,3).Value = objChild.Mail
        objExcel.ActiveCell.Offset(1,0).Activate                  'move 1 down
      End If
  Next
Next
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''End Sites

set objRange = objWorksheet1.UsedRange
set objRange2 = objExcel.Range("A1")

objRange.Sort objRange2, xlAscending, , , , , , xlYes
'Sorts ALL used Cells by Column 1 (A1).  xlAscending, sorts ascending, xlYes means Header Row=Yes

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Imports First/Last Name from SQL
objExcel.ActiveSheet.Range("E2").Activate
Set objContainer = GetObject("LDAP://OU=Long Island,DC=JSC,DC=COM")

objContainer.Filter = Array("user")
For Each objChild In objContainer
 If objChild.Mail <> "" And Len(objChild.Mail) > 2 Then 'Test for non-blank and greater than 2 characters in the Mail property
            objExcel.ActiveCell.Value = objChild.SN
      objExcel.ActiveCell.Offset(0,1).Value = objChild.GivenName
      objExcel.ActiveCell.Offset(0,2).Value = objChild.Mail
      objExcel.ActiveCell.Offset(1,0).Activate                  'move 1 down
  End If
Next

Set objContainer = GetObject("LDAP://OU=NYC,DC=JSC,DC=COM")

objContainer.Filter = Array("user")
For Each objChild In objContainer
 If objChild.Mail <> "" And Len(objChild.Mail) > 2 Then 'Test for non-blank and greater than 2 characters in the Mail property
      objExcel.ActiveCell.Value = objChild.SN
      objExcel.ActiveCell.Offset(0,1).Value = objChild.GivenName
                    objExcel.ActiveCell.Offset(0,2).Value = objChild.Mail
      objExcel.ActiveCell.Offset(1,0).Activate                  'move 1 down
  End If
Next

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Auto Size Columns
objWorkSheet1.Columns.AutoFit()
'Autosize for Column Width for Work Sheet 1
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''End Auto Size Columns

'Set objRange3  = objExcel.Range("F2")
'objRange.Sort objRange3, xlAscending, , , , , , xlYes

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Compare
Set objRangeQRY = objWorksheet1.Range("G1").EntireColumn
i = 1
j = 1
Do Until objExcel.Cells(i, 4).Value = ""
    strLast_Name = objExcel.Cells(i, 4).Value
    strFirst_Name = objExcel.Cells(j, 2).Value
    Set objSearch = objRangeQRY.Find(strLast_Name)

    If objSearch Is Nothing Then
        Wscript.Echo strLast_Name & " was not found."
    End If
    i = i + 1
    j = j + 1    
   Loop
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''End Compare




set objWorksheet2 = objWorkBook.WorkSheets(2)
objWorksheet2.Name = "Assentor Users"
objWorksheet2.activate                              'activates Assentor Users Work Sheet

Wscript.Echo "Comparison Complete"

objWorkBook.SaveAs(strFileName)
objExcel.Quit
_______________________________________________

So now it will compare unique Email Addresses.
0
Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
LVL 67

Expert Comment

by:sirbounty
ID: 18861250
Glad you found a solution. :^)
0
 
LVL 1

Author Comment

by:jsctechy
ID: 18905766
Yes,
Imported the SQL side of things now.

How can I stop my server from pulling specific email address such as..
BackupExec@domain.com, Admin@domain.com?
0
 
LVL 67

Accepted Solution

by:
sirbounty earned 500 total points
ID: 18905885
Do your comparison here:

'[...]
For Each objChild In objContainer
 If objChild.Mail <> "" And Len(objChild.Mail) > 2 Then 'Test for non-blank and greater than 2 characters in the Mail property
'add this...
  If lcase(objChild.Mail) <> "backupexec@domain.com" and lcase(objChild.Mail) <> "admin@domain.com" Then
            objExcel.ActiveCell.Value = objChild.SN
 
0
 
LVL 1

Author Comment

by:jsctechy
ID: 18906051
Like this?

sites=Array("OU=New Jersey","OU=Long Island","OU=NYC","CN=Users","CN=BuiltIn")

For Each site in sites
  Set objContainer = GetObject("LDAP://" & site & ",DC=JSC,DC=COM")
  objContainer.Filter = Array("user")
  For Each objChild In objContainer
      If objChild.Mail <> "" And Len(objChild.Mail) > 2 Then 'Test for non-blank and greater than 2 characters in the Mail property
      If lcase(objChild.Mail) <> "Admin@JSC.com" and lcase(objChild.Mail) <> "BlaBerry.JSC.com" Then
        objExcel.ActiveCell.Value = objChild.SN
        objExcel.ActiveCell.Offset(0,1).Value = objChild.GivenName
        objExcel.ActiveCell.Offset(0,2).Value = objChild.Description
        objExcel.ActiveCell.Offset(0,3).Value = objChild.Mail
        objExcel.ActiveCell.Offset(1,0).Activate                  'move 1 down
      End If
  Next
Next
0
 
LVL 67

Assisted Solution

by:sirbounty
sirbounty earned 500 total points
ID: 18906081
Not exactly...we need to make sure the case matches...lcase is a function to use lower case (ucase does the opposite).
So, this should be:

If lcase(objChild.Mail) <> "admin@jsc.com" and lcase(objChild.Mail) <> "blaberry.jsc.com" Then
     
0
 
LVL 1

Author Comment

by:jsctechy
ID: 18906122
I am confused, what is the difference if it is lower case or upper case?
0
 
LVL 67

Expert Comment

by:sirbounty
ID: 18906139
It just has to match on both sides....


Otherwise, your comparison may read:

Is "Admin@JSC.Com" equal to "ADMIN.JSC.Com" - of course, it won't be...so you need 'both' sides to be lower or upper case...
0
 
LVL 1

Author Comment

by:jsctechy
ID: 18906196
I see.  The script will determine case sensative?
I can always change the case of the email addys.
This is very helpful.  I can just continue the same format, adding the word and...
If lcase(objChild.Mail) <> "admin@jsc.com" and lcase(objChild.Mail) <> "blaberry.jsc.com" and and lcase(objChild.Mail) <> "test@jsc.com" and lcase(objChild.Mail) <> "more@jsc.com" Then

Correct?
0
 
LVL 67

Expert Comment

by:sirbounty
ID: 18906313
Well now, if you're going to go more than a couple, I'd say go back to your array method above...

arrMail=Array("mail1@domain.com", "mail2@domain.com") 'etc...

Then use the filter function

strTemp=Filter(arrMail, lcase(objChild.Mail))
If strTemp <> "" Then 'a match has been made...
0
 
LVL 1

Author Comment

by:jsctechy
ID: 18906577
where would I put something like that?  next line where I have sites=Array(..........)?
0
 
LVL 67

Assisted Solution

by:sirbounty
sirbounty earned 500 total points
ID: 18906795
Anywhere prior to the test actually (well, the array creation piece)...


sites=Array("OU=New Jersey","OU=Long Island","OU=NYC","CN=Users","CN=BuiltIn")

arrMail=Array("mail1@domain.com", "mail2@domain.com") 'etc...

For Each site in sites
  Set objContainer = GetObject("LDAP://" & site & ",DC=JSC,DC=COM")
  objContainer.Filter = Array("user")
  For Each objChild In objContainer
      If objChild.Mail <> "" And Len(objChild.Mail) > 2 Then 'Test for non-blank and greater than 2 characters in the Mail property
      strTemp=Filter(arrMail, lcase(objChild.Mail))
      If strTemp Then
        objExcel.ActiveCell.Value = objChild.SN
        objExcel.ActiveCell.Offset(0,1).Value = objChild.GivenName
        objExcel.ActiveCell.Offset(0,2).Value = objChild.Description
        objExcel.ActiveCell.Offset(0,3).Value = objChild.Mail
        objExcel.ActiveCell.Offset(1,0).Activate                  'move 1 down
       End If
      End If
  Next
Next
0
 
LVL 1

Author Comment

by:jsctechy
ID: 18907247
I am getting an error with this line
strTemp=Filter(arrMail, lcase(objChild.Mail))

Error - Type Mismatch
Code - 800A000D
0
 
LVL 1

Author Comment

by:jsctechy
ID: 18907258
Sorry- this is the line
If strTemp <> "" Then
0
 
LVL 67

Assisted Solution

by:sirbounty
sirbounty earned 500 total points
ID: 18907319
No - take strTemp <> "" back out of there...you're using this now:

      strTemp=Filter(arrMail, lcase(objChild.Mail))
      If strTemp Then


And in truth - the 2nd line there, we're cheating on...
The strTemp will return basically an array if there's a match.
Normally if you want to test the array, you'd check it a couple of other different ways, but since you only want to know that there's 'not' a match, we can use
If strTemp is True Then... (pseudo for above code).
What this means is strTemp = -1
-1 is the equivalent of "True" - or more accurately "no matches" (the filtered array is empty)...
0
 
LVL 1

Author Comment

by:jsctechy
ID: 18907363
I am confused :)

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''Sets Sites, Pulls in Last,First Names to Column A
sites=Array("OU=New Jersey","OU=Long Island","OU=NYC","CN=Users","CN=BuiltIn")
arrMail=Array("aforward@josephstevens.com","bkupexec@josephstevens.com","ops@josephstevens.com","besadmin@josephstevens.com","user3@josephstevens.com","user4@josephstevens.com","user@josephstevens.com","reportgenerator@josephstevens.com","ocopier@josephstevens.com","bnyftp@josephstevens.com","guest2joe@josephstevens.com","pershing@josephstevens.com","gmessaging@josephstevens.com","assentor@josephstevens.com","administrator@josephstevens.com","journal@josephstevens.com","jsmailbkup@josephstevens.com")
'strTemp = Filter(arrMail, lcase(objChild.Mail))

For Each site in sites
  Set objContainer = GetObject("LDAP://" & site & ",DC=JSC,DC=COM")
  objContainer.Filter = Array("user")
  For Each objChild In objContainer
       If objChild.Mail <> "" And Len(objChild.Mail) > 2 Then
         strTemp=Filter(arrMail, lcase(objChild.Mail))
       If strTemp Then
        objExcel.ActiveCell.Value = objChild.SN
        objExcel.ActiveCell.Offset(0,1).Value = objChild.GivenName
        objExcel.ActiveCell.Offset(0,2).Value = objChild.Description
        objExcel.ActiveCell.Offset(0,3).Value = objChild.Mail
        objExcel.ActiveCell.Offset(1,0).Activate                                    'move 1 down
        End If
      End If
  Next
Next
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''End Sites

Getting same error
0
 
LVL 1

Author Comment

by:jsctechy
ID: 18907388
the code you sent me will test for an email address that has at least 2 characters in the mail field - AND will also leave out any I specify in the arrMail, correct?
0
 
LVL 67

Assisted Solution

by:sirbounty
sirbounty earned 500 total points
ID: 18907395
I see where I goofed...

'[nothing changed above]
For Each site in sites
  Set objContainer = GetObject("LDAP://" & site & ",DC=JSC,DC=COM")
  objContainer.Filter = Array("user")
  For Each objChild In objContainer
       If objChild.Mail <> "" And Len(objChild.Mail) > 2 Then
         strTemp=Filter(arrMail, lcase(objChild.Mail))
         If ubound(strTemp) <> -1 Then
    '[nothing changed below]    
0
 
LVL 1

Author Comment

by:jsctechy
ID: 18907438
thanks that does work... sort of :)
The addresses typed in the array are the addresses I do not want to import!  Do I need to say false, rather than -1?
0
 
LVL 1

Author Comment

by:jsctechy
ID: 18907453
I did this- looks good now.

For Each site in sites
  Set objContainer = GetObject("LDAP://" & site & ",DC=JOSEPHSTEVENS,DC=COM")
  objContainer.Filter = Array("user")
  For Each objChild In objContainer
       If objChild.Mail <> "" And Len(objChild.Mail) > 2 Then
         strTemp=Filter(arrMail, lcase(objChild.Mail))
       If ubound(strTemp) <> False Then
        objExcel.ActiveCell.Value = objChild.SN
        objExcel.ActiveCell.Offset(0,1).Value = objChild.GivenName
        objExcel.ActiveCell.Offset(0,2).Value = objChild.Description
        objExcel.ActiveCell.Offset(0,3).Value = objChild.Mail
        objExcel.ActiveCell.Offset(1,0).Activate                                    'move 1 down
        End If
      End If
  Next
Next


Thanks for all the help.  This part of the script is done :)  Now off to find out how I can do some other things.
0
 
LVL 67

Expert Comment

by:sirbounty
ID: 18907457
True = -1
False = 0

If you're using filter, the function creates an array, based upon another array.

Array1=Array("A","B","C")

FilterArray=Filter(Array1,"A") will return
ubound(FilterArray) of 0 (1 match)

FilterArray=Filter(Array1,"Z") will return
ubound(FilterArray) of -1 (0 matches)
0
 
LVL 67

Expert Comment

by:sirbounty
ID: 18907484
Ok...fyi:
   If ubound(strTemp) <> False Then
if the same as
   If ubound(strTemp) = True Then
   or even
   If ubound(strTemp) Then  'True is 'assumed'


0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
ejb message driven bean mdb creation steps 2 22
Programming Codes 2 21
copy same as above data 18 37
Records from Access to Excel to specific cells 5 25
In this post we will learn how to connect and configure Android Device (Smartphone etc.) with Android Studio. After that we will run a simple Hello World Program.
Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

856 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question