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

 

[Noir]

EXCELLENT!!

Jim North for President!!

 

[Noir]

Jim,
One final question. How do you edit the code so it will look for data in Column B of book2 instead of column A? When i try to edit the code, it doesn't work properly.

Thx,
Noir

 

[Jim North]

Hi Noir,

I'm at home without the Excel to test it, but this should work (if it doesn't, let me know and I will get to you on Tuesday):

<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("B65536").End(xlUp).Row

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

With wksSlave.Range("B1:B" & 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, 2).Value Then
FoundIt = False
End If
CurrRow = CurrRow + 1
Next i
If FoundIt = True Then
FoundCount = FoundCount + 1
wksSlave.Range("B" & SetStart & ":B" & 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>

Hope this does it... if not send me a private message.

 

[Noir]

Works GREAT!!

Thx,
Noir