Horizontal and Vertical search using VBA Help Please

[newbee2]

Hi,
What's the best way to search a table horizontally,
restricting to a horizontal range (to 16 cells), to see if the values match another table's values on a separate sheet which run vertically again restricting the range (to 16 cells).
When the two equal each other then do something, if they
don't then increment one or the other searches untill
something else matches. Then loop untill the end of the
horizontal table is reached.
Can someone start me with the code, I have tried if
statements ahhhhhhhhh, i'm lost.
Regards
william

 

[cmmrfrds]

Here is a function from one of my programs that compares 2 tables field by field. I joined both tables into 1 recordset to make it easier. Also, this is a lot of code but maybe some of it will be useful at least to get you started.


Function ZACompareOldToNew() As String
'---------- Compare Old to New for the ZA records -------------------
'---------- First find if any fields have changed, then build Export Records
'---------- ZA's need LIN records so need to check If LIN already in Export
'---------- If no LIN then build 2 LIN Export records
Dim mKey As Integer, RSMT As New Recordset, cnn As ADODB.Connection
Dim Sql1 As String, sql2 As String, sql3 As String, sql4 As String
Dim SqlString As String, ZACnt As Integer, recCnt As Integer
Set cnn = CurrentProject.Connection
Sql1 = "SELECT Table852ZANew.ZAKey, Table852ZANew.ItemNumber, "
Sql1 = Sql1 + "Table852ZANew.WarehouseNumber, Table852ZANew.BuildDate, "
Sql1 = Sql1 + "Table852ZANew.DG, Table852ZANew.OQ, Table852ZANew.PO, "
Sql1 = Sql1 + "Table852ZANew.QA, Table852ZANew.QC, "
Sql1 = Sql1 + "Table852ZANew.QD, Table852ZANew.QL, Table852ZANew.QM, "
Sql1 = Sql1 + "Table852ZANew.QO, Table852ZANew.QP, "
Sql1 = Sql1 + "Table852ZANew.QR, Table852ZANew.QS, Table852ZANew.QT, "
Sql1 = Sql1 + "Table852ZANew.ZA02, Table852ZANew.ZA03, "
Sql1 = Sql1 + "Table852ZANew.ZA04, Table852ZANew.ZA05, Table852ZANew.ZA06, "
Sql1 = Sql1 + "Table852ZANew.ZA07, Table852ZAOld.ZAKey, "
Sql1 = Sql1 + "Table852ZAOld.ItemNumber, Table852ZAOld.WarehouseNumber, "
Sql1 = Sql1 + "Table852ZAOld.BuildDate, Table852ZAOld.DG, "
Sql1 = Sql1 + "Table852ZAOld.OQ, Table852ZAOld.PO, Table852ZAOld.QA, "
Sql1 = Sql1 + "Table852ZAOld.QC, Table852ZAOld.QD, Table852ZAOld.QL, "
Sql1 = Sql1 + "Table852ZAOld.QM, Table852ZAOld.QO, Table852ZAOld.QP, "
Sql1 = Sql1 + "Table852ZAOld.QR, Table852ZAOld.QS, Table852ZAOld.QT, "
Sql1 = Sql1 + "Table852ZAOld.ZA02, Table852ZAOld.ZA03, Table852ZAOld.ZA04, "
Sql1 = Sql1 + "Table852ZAOld.ZA05, Table852ZAOld.ZA06, "
Sql1 = Sql1 + "Table852ZAOld.ZA07 "
Sql1 = Sql1 + "FROM Table852ZAOld RIGHT JOIN Table852ZANew ON "
sql2 = " (Table852ZAOld.ItemNumber = Table852ZANew.ItemNumber) AND "
sql3 = " (Table852ZAOld.WarehouseNumber = Table852ZANew.WarehouseNumber) "
sql4 = " ORDER BY Table852ZANew.ItemNumber, Table852ZANew.WarehouseNumber;"

SqlString = Sql1 & sql2 & sql3 & sql4
''''''''''Debug.Print " Table852ZA SQL = "; SqlString
RSMT.Open SqlString, cnn, adOpenKeyset, adLockReadOnly
''''''''''Debug.Print " Table852ZA BOF = "; RSMT.BOF
If (RSMT.BOF And RSMT.EOF) Then
ZACompareOldToNew = "No Records to Compare "
RSMT.Close
Exit Function
End If
RSMT.MoveFirst
Dim indx As Integer, indx2 As Integer
Dim needLIN As String, retcode1 As String, retcode2 As String
Dim logfld As String, logdsc As String, chg As Variant
Dim calc1 As Double, calc2 As Double, idx As Integer
Dim comp1 As Variant, comp2 As Variant
Dim actCode As String, refID As String, qty As Long
Dim needZA As String

For indx2 = 0 To (RSMT.RecordCount - 1)
glbItemNumber = RSMT![Table852ZANew.ItemNumber]
''-- loop thru all the fields matching pairs looking for changes -----
''-- Value pairs are 23 apart, start at 4 ignore 1st four fields
''-- Fields have nulls need Nz Function
retcode2 = ZAExportFindItem()
If retcode2 = "Yes" Then ' record already exists, don't build another
GoTo ResumeNext
End If
needZA = "No"
For indx = 4 To 16 'Match 4 thru 16 fields skip 0-3, skip over 17-22.

needLIN = "No" ' --initialize
retcode1 = "No"
'''---Debug.Print "field Names = "; RSMT.Fields(indx).Name
comp1 = RSMT.Fields(indx).Value
comp2 = RSMT.Fields(indx + 23).Value
If (Nz(comp1, 0)) <> (Nz(comp2, 0)) Then
' -- Value is different, start building ZA record ---------
' -- Find the LIN and get Vendor Code
needZA = &quot;Yes&quot;
retcode1 = LINTableFindItem()
'''Debug.Print &quot; From LINTableFindItem retCode = &quot;; retCode1
'''Debug.Print &quot; VendorCode = &quot;; glbVendorCode
If retcode1 <> &quot;yes&quot; Then
' -- No LIN then log error and check next field -------
logdsc = &quot;Cannot find the LIN New Record for the Item&quot;
logfld = RSMT.Fields(indx).Name
retcode2 = LogError(logfld, logdsc)
GoTo ResumeNext
End If
retcode2 = SaveVendorCodes()
''Debug.Print &quot; SaveVendorCodes VendorCode = &quot;; glbVendorCode
retcode1 = LINExportFindItem() ' -- check for LIN in Export
'''Debug.Print &quot; From LINExportFindItem retCode = &quot;; retCode1
If retcode1 <> &quot;yes&quot; Then
' -- Build the LIN Export records
retcode1 = LINBuildExport()
End If

End If

Next '-- loop to check for change

If needZA = &quot;No&quot; Then
GoTo ResumeNext
End If

For indx = 4 To 16 'Match 4 thru 16 fields skip 0-3, skip over 17-22.
' -- get the changes and build Export record ------
qty = Nz(RSMT.Fields(indx).Value, 0)
Dim retcode As String, qtyQual As String
If indx = 15 Then '-- &quot;QS&quot; needs a QTY record
qtyQual = &quot;OC&quot;
retcode = ExportQty(qtyQual, qty)
End If
' ------ Build ZA Export
actCode = Right(RSMT.Fields(indx).Name, 2) ' -- field name is Code
refID = Nz(RSMT.Fields(22).Value, 0) ' -- send ref ID
retcode1 = ZABuildExport(actCode, refID, qty)
Next '-- loop to build ZA's

ResumeNext:
RSMT.MoveNext
Next '-- loop thru records

' Return value
ZACompareOldToNew = 1

RSMT.Close
End Function

 

[newbee2]

Thanks very much appreciated.