Arrays, searches, and replacement

[ukdane]

I'm moving this post from another thread to here, as the other thread has become rather cluttered, and people may not be reading it. Here's the problem.

I have two tables. A data table, and a results table.
The data table is located on one worksheet, and fills a range from B2:ANxxx where xxx is variable.

The results table is located in another worksheet. The results table fills a range from B5:ANyyy where yyy is variable.

I need to take each item from the table data, and look to see if the contents of field B, E, and F match those of any of the data found on the results table. B, E, and F all contain text.

If it is a complete match with all three items, then it needs to replace the data in the results table with the data from the rest of the row.

If the data does not match any of the results, then the data needs to be added as the last item on the results table.

This needs to be repeated for each row in the data table. And it needs to be checked with each item in the results table.



I'm not sure how to approach this, but maybe the three columns that need to be checked with each other (B, E, and F in each sheet) could be joined together, and placed in an array that is the size of the relevant table (-1 as arrays start at 0).

Then I could run a loop that checks each row in the array in the data table with each row in the array in the results table.


Any ideas how best to accomplish this?
Is the method above of using two arrays the best method of doing this, or is there another solution?

Cheers

[mdmackillop]

Whilst your description is very clear, a sample layout /result makes things so much easier. I, and any other considering this, would need to make up a layout with sample data on which to test solutions.

[ukdane]

OK, I've included a dummy workbook.

There are a couple of differences here.

1) I made an error in my first post. The two tables would actually be located on two different workbooks (in the example they are on two different worksheets).

2) The data doesn't go all the way to from B to AN, although in my actual workbooks they do.

So the code should take each individual row from the data page, and look to see if Column B, E, and F already exist on the results worksheet. If it does, then the data should be replaced on the results page with that of the data.

If it isn't the same, then it should be added to the end of the results page.

In the example workbook, the two rows of data, that contain the text replacement in column K, should replace their equivalent row in the results page, whilst the other (4) rows should all be added to the end of the results page.

As noted above, the number of rows on the data workbook can vary each time the code needs to run, and obviously, as I'm adding data to the end of the results sheet, the number of rows here will also change.

I hope this helps explain a little more what I want to achieve.

Thanks

[GTO]

Greetings ukdane,

I'm not so sure the fastest/neatest method, but seems to work.

Hope this helps,

Mark

[vba]Sub UpdateOrAdd()

Dim _
wksData As Worksheet, _
wksResults As Worksheet, _
rData As Range, _
rResults As Range, _
rCell As Range, _
rCell_R As Range, _
lLRow_Dat As Long, _
lLRow_Res As Long, _
strData As String, _
bolFound As Boolean

'// Set a reference to both sheets, based upon their tab names. As long as these //
'// sheets aren't going to be deleted, you could just use codename(s). //
Set wksData = ThisWorkbook.Worksheets("Data")
Set wksResults = ThisWorkbook.Worksheets("Results")

'// Find last used row in 'Data' sheet. //
lLRow_Dat = wksData.Cells(Rows.Count, 2).End(xlUp).Row

'// Set 'Data' sheet range. //
Set rData = wksData.Range("B2:B" & lLRow_Dat)

For Each rCell In rData

'// Use the concatenated string from the three cells of the current row being //
'// looked at on 'Data' to compare... //
strData = DataRow(rCell.Resize(1, 10))

'// Find last row and set reference to range on 'Results'. //
lLRow_Res = wksResults.Cells(Rows.Count, 2).End(xlUp).Row
Set rResults = wksResults.Range("B5:B" & lLRow_Res)

'// Explicitly assign due to loop. //
bolFound = False

'// SAA, for ea cell in Col B of range in 'Results', see if concatenated string //
'// matches... //
For Each rCell_R In rResults
'// If yes, overwrite (update) data, set Flag and bail outta the loop; ... //
If DataRow(rCell_R.Resize(1, 10)) = strData Then
rCell_R.Resize(1, 10).Value = rCell.Resize(1, 10).Value
bolFound = True
Exit For
End If
Next

'// ...else if not found, add below last row on 'Results'. //
If Not bolFound Then
wksResults.Range("B" & lLRow_Res + 1 & ":K" & lLRow_Res + 1).Value = _
rCell.Resize(1, 10).Value
End If
Next
End Sub

Function DataRow(rng As Range) As String
Dim a(0 To 2)
'// Get the values of cell in Col 1, 4, 5 of row being looked at and return //
'// concatenated string. //
a(0) = rng(1).Value
a(1) = rng(4).Value
a(2) = rng(5).Value
DataRow = a(0) & a(1) & a(2)
End Function[/vba]

[mikerickson]

I think this will do what you want. It also uses concatenated strings for the comparison, but uses a helper column. To expand to AN, alter the one line indicated.
[VBA]Sub test()
Dim dataRange As Range
Dim resultsRange As Range
Dim helperColumn As Range
Dim formulaStr As String
Dim oneCell As Range

With ThisWorkbook.Sheets("Data")
Set dataRange = Range(.Cells(2, 2), .Cells(.Rows.Count, 11).End(xlUp)): Rem column AN = column 40
End With
With ThisWorkbook.Sheets("results")
Set resultsRange = Range(.Cells(5, 2), .Cells(.Rows.Count, 2).End(xlUp)).Resize(, dataRange.Columns.Count)
End With

With dataRange.Parent
Set helperColumn = Application.Intersect(dataRange.EntireRow, .UsedRange.Offset(0, .UsedRange.Columns.Count + 1).Cells(1, 1).EntireColumn)
End With

Rem make helper column
With helperColumn
formulaStr = "RC2&CHAR(5)&RC5&CHAR(5)&rc6"
formulaStr = "=MATCH(" & formulaStr & "," _
& resultsRange.Columns(1).Address(, , xlR1C1, True) & "&CHAR(5)&" _
& resultsRange.Columns(4).Address(, , xlR1C1, True) & "&CHAR(5)&" _
& resultsRange.Columns(5).Address(, , xlR1C1, True) & ",0)"

.Cells(1, 1).FormulaArray = formulaStr
.Cells.FillDown
End With

Rem replace duplicated rows
On Error Resume Next
For Each oneCell In helperColumn.SpecialCells(xlCellTypeFormulas, xlNumbers)
resultsRange.Rows(oneCell.Value).Value = dataRange.Rows(oneCell.Row - dataRange.Row + 1).Value
Next oneCell
On Error GoTo 0

Rem add new rows
On Error Resume Next
For Each oneCell In helperColumn.SpecialCells(xlCellTypeFormulas, xlErrors).Areas
With Application.Intersect(dataRange, oneCell.EntireRow)
NextRow(resultsRange).Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
Next oneCell
On Error GoTo 0

Rem remove helper column
helperColumn.EntireColumn.Delete
End Sub

Function NextRow(inputRange As Range) As Range
With inputRange.Cells(1, 1).EntireColumn
Set NextRow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(, inputRange.Columns.Count)
End With
End Function
[/VBA]