VBA code that finds computer configuration matches

[Noir]

I maintain a listing of all workstations and servers purchased by my company. I have each workstation and server broken out by description. A standard (workstation) configuration may look as follows;

Book1, Sheet1
---------------------
A2 - ACME 700Mhz, P3, 256k
A3- 128MB SIMMS
A4 - 64MB Voodoo video card
A5 - CD Writer
A6 - 104 Standard KB
A7 - 17" LR Monitor
A8 - 2 Button Serial Mouse

I double-check my configuration list against the lists maintained by computer tech's (who physically receive the equipment) to ensure that we have accounted for the same number of computer configurations. (Note:The tech's always give me a count of how many configurations they have listed on their list). Many times, i spend "a lot" of time finding that out of 50 or 60 individual configurations i've checked, only 1 or 2 differ.

The following code (Many thanks to Anupam!!) does a search between my sheet1 configuration (A2:A8) and a co-worker workbook Book2, Sheet1, B2:B1000.

(1) I cannot quickly add new config's in my sheet1, colmn A to be search. The code makes you specify the number of lines within your config.

(2) The code will only match the two config's if the config in Book2 has 1 space above and below it separating the config from other data. If the config lines run together with other data, it will not find the config match. I would like to have the code modified so it will simply look for a "consecutive configuration" match no matter what data is above or below it.

Here is the code;

Sub doit()
Dim blnFoundMatch As Boolean
Dim counter As Integer
Dim arrMyconfig(1 To 7) As String
Dim strSheetname As String
Dim strMySheetname As String
blnFoundMatch = False
counter = 0
strMySheetname = "Sheet1"
'This is my data workbook
Workbooks("Book1.xls").Activate
Sheets(strMySheetname).Select
arrMyconfig(1) = Range("A2")
arrMyconfig(2) = Range("A3")
arrMyconfig(3) = Range("A4")
arrMyconfig(4) = Range("A5")
arrMyconfig(5) = Range("A6")
arrMyconfig(6) = Range("A7")
arrMyconfig(7) = Range("A8")
'This is the woorkbook you get from you co -workers
Workbooks("Book2.xls").Activate
Sheets("Sheet1").Select
For i = 2 To 1000 Step 7 'You will have to change the counter base on how many rows you have (1000 for 1000 rows in Book 5)
If Range("B" & i).Value = arrMyconfig(1) Then
If Range("B" & i + 1).Value = arrMyconfig(2) Then
If Range("B" & i + 2).Value = arrMyconfig(3) Then
If Range("B" & i + 3).Value = arrMyconfig(4) Then
If Range("B" & i + 4).Value = arrMyconfig(5) Then
If Range("B" & i + 5).Value = arrMyconfig(6) Then
If Range("B" & i + 6).Value = arrMyconfig(7) Then
blnFoundMatch = True
End If
End If
End If
End If
End If
End If
End If
If blnFoundMatch Then
counter = counter + 1
blnFoundMatch = False
End If
Next i
Workbooks("Book1.xls").Activate
Sheets(strMySheetname).Select
Range("B2").Value = counter


End Sub

Thx,
Noir
This message was edited by Noir on 2002-09-11 06:14

 

[Jim North]

Is it possible that you would have a master configuration of 7 lines, and your co-workers have a 8 (or more)configuration where their first 7 lines match your 7 lines?

 

[Noir]

it would be rare but, yes it "could" happen.

 

[Jim North]

In the world of programming, if it happens once in 1000000000000000 times, you have to allow and test for it....

Ok, let say it happens. How do I test to be sure that there line 8 is not part of their configuration in lines 1 thru 7??

 

[Noir]

In a rare case like that, i will accept that my 7 lines and their 8 lines do not equal a match.

The benefit to a code like this is that it eliminates the need of me to check the 50 or so config's that "do" match. (I will run this code prior to reviewing my co-workers workbook knowing that i only have 2 or 3, etc. config's that do not match. It will help me while visually scanning for the odd configurations). As you can see, it would save me an enormouse amount of time.

Noir

 

[Jim North]

This is working on my sample:<pre>
Sub CountConfigs()

Dim wksMaster As Worksheet
Dim wksSlave As Worksheet
Dim FoundIt As Boolean
Dim strChassis As String
Dim lngMasterLastRow As Long
Dim lngSlaveLastRow As Long
Dim c As Range
Dim CurrRow As Long
Dim FoundCount As Long
Dim FirstAddress As String
Dim i As Integer

Application.ScreenUpdating = False

' point to the appropriate worksheets
Set wksMaster = ActiveWorkbook.ActiveSheet
' Set wksSlave = Workbooks("Noir.xls").Sheets("Sheet2") ' for testing
Set wksSlave = Workbooks("Book2.xls").Sheets("Sheet1")


' Last row on the Master sheet
lngMasterLastRow = wksMaster.Range("A65536").End(xlUp).Row
' Last row on the Slave sheet
lngSlaveLastRow = wksSlave.Range("A65536").End(xlUp).Row

' Get the chassis description
strChassis = wksMaster.Range("A2").Value

With wksSlave.Range("A1:A" & lngSlaveLastRow)
FoundIt = False
Set c = .Find(strChassis, LookIn:=xlValues, LookAt:=xlWhole) ' search for the chassis
If Not c Is Nothing Then ' at least one match is found
FirstAddress = c.Address
Do
FoundIt = True ' assume its found
CurrRow = c.Row + 1
For i = 3 To lngMasterLastRow
If wksMaster.Range("A" & i).Value<> wksSlave.Cells(CurrRow, 1).Value Then
FoundIt = False
End If
CurrRow = CurrRow + 1
Next i
If FoundIt = True Then FoundCount = FoundCount + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address<> FirstAddress
End If
wksMaster.Range("B2").Value = FoundCount
End With

Application.ScreenUpdating = True

End Sub</pre>

_________________
JRN

Excel 2000; Windows 2000
This message was edited by Jim North on 2002-09-11 12:45

 

[Noir]

Hey Jim, works GREAT!!

Thanks for all your time!

Noir

 

[Jim North]

me again...

I was wondering it would be helpful if we did something to highlight the matching sets on the co-worker workbook... such as changing the text to red. Do you see any benefit to this?

 

[Noir]

Definitely. That would be a great touch. Will it be hard to do?

Noir

 

[Jim North]

I don't think it's major.... but then, I haven't tried it yet. I just thought it might give you a quick visual check. I'll give it a go and let you know what happens.

 

[Jim North]

Hey... it was almost painless!

<pre>
Sub CountConfigs()

Dim wksMaster As Worksheet
Dim wksSlave As Worksheet
Dim FoundIt As Boolean
Dim strChassis As String
Dim lngMasterLastRow As Long
Dim lngSlaveLastRow As Long
Dim c As Range
Dim CurrRow As Long
Dim FoundCount As Long
Dim FirstAddress As String
Dim SetStart As Long
Dim i As Integer

Application.ScreenUpdating = False

' point to the appropriate worksheets
Set wksMaster = ActiveWorkbook.ActiveSheet
' Set wksSlave = Workbooks("Noir.xls").Sheets("Sheet2") ' for testing
Set wksSlave = Workbooks("Book2.xls").Sheets("Sheet1")


' Last row on the Master sheet
lngMasterLastRow = wksMaster.Range("A65536").End(xlUp).Row
' Last row on the Slave sheet
lngSlaveLastRow = wksSlave.Range("A65536").End(xlUp).Row

' Get the chassis description
strChassis = wksMaster.Range("A2").Value

With wksSlave.Range("A1:A" & lngSlaveLastRow)
FoundIt = False
Set c = .Find(strChassis, LookIn:=xlValues, LookAt:=xlWhole) ' search for the chassis
If Not c Is Nothing Then ' at least one match is found
FirstAddress = c.Address
Do
FoundIt = True ' assume its found
CurrRow = c.Row + 1
SetStart = c.Row ' store the location of the first record of the set
For i = 3 To lngMasterLastRow
If wksMaster.Range("A" & i).Value <> wksSlave.Cells(CurrRow, 1).Value Then
FoundIt = False
End If
CurrRow = CurrRow + 1
Next i
If FoundIt = True Then
FoundCount = FoundCount + 1
wksSlave.Range("A" & SetStart & ":A" & CurrRow - 1).Font.ColorIndex = 3
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress
End If
wksMaster.Range("B2").Value = FoundCount
End With

Application.ScreenUpdating = True

End Sub

</pre>