• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 960
  • Last Modified:

VBScript, Comparing Excel Columns

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
jsctechy
Asked:
jsctechy
  • 13
  • 11
5 Solutions
 
sirbountyCommented:
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
 
jsctechyAuthor Commented:
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
 
jsctechyAuthor Commented:
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
The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

 
sirbountyCommented:
Glad you found a solution. :^)
0
 
jsctechyAuthor Commented:
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
 
sirbountyCommented:
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
 
jsctechyAuthor Commented:
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
 
sirbountyCommented:
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
 
jsctechyAuthor Commented:
I am confused, what is the difference if it is lower case or upper case?
0
 
sirbountyCommented:
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
 
jsctechyAuthor Commented:
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
 
sirbountyCommented:
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
 
jsctechyAuthor Commented:
where would I put something like that?  next line where I have sites=Array(..........)?
0
 
sirbountyCommented:
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
 
jsctechyAuthor Commented:
I am getting an error with this line
strTemp=Filter(arrMail, lcase(objChild.Mail))

Error - Type Mismatch
Code - 800A000D
0
 
jsctechyAuthor Commented:
Sorry- this is the line
If strTemp <> "" Then
0
 
sirbountyCommented:
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
 
jsctechyAuthor Commented:
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
 
jsctechyAuthor Commented:
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
 
sirbountyCommented:
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
 
jsctechyAuthor Commented:
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
 
jsctechyAuthor Commented:
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
 
sirbountyCommented:
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
 
sirbountyCommented:
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

Never miss a deadline with monday.com

The revolutionary project management tool is here!   Plan visually with a single glance and make sure your projects get done.

  • 13
  • 11
Tackle projects and never again get stuck behind a technical roadblock.
Join Now