Link to home
Start Free TrialLog in
Avatar of jsctechy
jsctechyFlag for United States of America

asked on

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
Avatar of sirbounty
sirbounty
Flag of United States of America image

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...
Avatar of jsctechy

ASKER

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?
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.
Glad you found a solution. :^)
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?
ASKER CERTIFIED SOLUTION
Avatar of sirbounty
sirbounty
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
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
SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
I am confused, what is the difference if it is lower case or upper case?
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...
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?
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...
where would I put something like that?  next line where I have sites=Array(..........)?
SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
I am getting an error with this line
strTemp=Filter(arrMail, lcase(objChild.Mail))

Error - Type Mismatch
Code - 800A000D
Sorry- this is the line
If strTemp <> "" Then
SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
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
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?
SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
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?
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.
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)
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'