Solved

VBScript, Comparing Excel Columns

Posted on 2007-04-04
24
935 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
 
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
What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 
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

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

A short article about a problem I had getting the GPS LocationListener working.
Displaying an arrayList in a listView using the default adapter is rarely the best solution. To get full control of your display data, and to be able to refresh it after editing, requires the use of a custom adapter.
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…

762 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

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now