CODEWITHSUNDEEP
excelvba
JoeP
JoeP

Reputation: 876

Select All Where For Each - Excel Macro or VB Equivalent

I need to collate data from 3 Excel spreadsheets in a very specific way, but I'm having absolutely no luck in finding the functions or commands I need to use and for some reason even Google isn't helping me today.

For each line of Sheet1 I want to "Find All rows on Sheet2 WHERE Sheet1 ColumnA is LIKE Sheet 2 ColumnA AND Sheet1 ColumnB is LIKE Sheet2 ColumnB". I think I could probably use EQUALS instead of LIKE with a wildcard character.

Then, for each result that is found by the first query I want to insert a new row below the current row in Sheet1 and copy the data from Sheet2 ColumnC into the newly inserted row ColumnC. I imagine I'm also going to need to have counted the amount of rows returned by the first query so that I can tell it to skip that many rows before repeating the loop, although even if it performs the loop on those new rows it shouldn't find any results anyway.

Obviously is someone wants to write the code for me then I'd be overjoyed! :) But even if anyone is able to let me know the best functions to use for each bit I need then I will still be most grateful, and just research them and put something together myself.

Thanks in advance,

Joe

Edit

Added Examples below, first sheet 1, then sheet 2, then the desired result of sheet 1 after the macro has been run. Also above I stated I would be searching for "LIKE" matches, however it would be more accurate to say I want to search where CELL CONTAINS

Sheet 1 Before Macro

Sheet 2 Containing Info

Sheet 1 After Macro

Upvotes: 0

Views: 458

Answers (1)

bhuang3
bhuang3

Reputation: 3633

Well, the following is my solution. By the way, if you can guarantee that the cells are already sorted, the code can be optimized for reducing comparison times.

//Code is not tested
Sub Collate()

    Dim row1 As Long
    Dim row2 As Long
    Dim match As Boolean

    Dim lastRow1 As Long
    Dim lastRow2 As Long

    Dim valA1 As String
    Dim valB1 As String
    Dim valA2 As String
    Dim valB2 As String
    Dim valC2 As String

    lastRow1 = Sheet1.Cells.SpecialCells(xlCellTypeLastCell).Row
    lastRow2 = Sheet2.Cells.SpecialCells(xlCellTypeLastCell).Row

    row1 = 2
    While row1 <= lastRow1
        valA1 = "*" & Sheet1.Cells.Range("A" & row1).Value & "*"
        valB1 = "*" & Sheet1.Cells.Range("B" & row1).Value & "*"
        For row2 = 2 To lastRow2
            valA2 = Sheet2.Cells.Range("A" & row2).Value
            valB2 = Sheet2.Cells.Range("B" & row2).Value
            valC2 = Sheet2.Cells.Range("C" & row2).Value
            If valA2 Like valA1 And valB2 Like valB1 Then
                match = True
                row1 = row1 + 1
                lastRow1 = lastRow1 + 1
                Sheet1.Cells.Range("A" & row1).EntireRow.Insert
                Sheet1.Cells.Range("C" & row1).Value = valC2
            End If
        Next row2

        row1 = row1 + 1
    Wend

End Sub

Upvotes: 1

Related Questions