CODEWITHSUNDEEP
vbaexcel
Astr0zombi3s
Astr0zombi3s

Reputation: 11

VBA loop through range moving values dynamically to intersect of two reference points

I have a workbook with 2 sheets. Sheet 1 has data in a table in A5:B11 with headers(Attributes/Data). It also has data in A1 we'll call the item ID.

On sheet 2 I have a a list of Item IDs in column A:A. In row 1 (B1:G1) a list of headers matching the potential values in A6:A11 on sheet 1.

I need a command button that will loop through the range B6:B11 and for each cell it will copy the data then find the location of it's corresponding header in A6:A11 and match it on sheet 2 B1:G1 then find the row that contains the Item ID in A1 sheet 1 on sheet 2 A:A.

On sheet 2 with the intersect of the values of Item ID and Attribute from sheet 1 I want to paste the copy data from the cell.

Below is the code I have so far, I can find the location of Item ID and Attribute on sheet 2. I just dont know how to build the loop to have it copy the data from B6:B11 to the intersects of the corresponding attribute and Item ID.

Sub compiler()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim x As Range
Dim y As Range

Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")

Set x = ws2.Range("A1:Z1000").Find(What:="21999", After:=ActiveCell, LookIn:=xlFormulas, _
        lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

Set y = ws2.Range("A1:Z1000").Find(What:="header 1", After:=ActiveCell, LookIn:=xlFormulas, _
        lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

If Not x Is Nothing Then
    MsgBox x.Address
    Else
    MsgBox "fail"
End If

If Not y Is Nothing Then
    MsgBox y.Address
    Else
    MsgBox "fail"
End If


End Sub

Upvotes: 0

Views: 1191

Answers (1)

Tim Williams
Tim Williams

Reputation: 166256

Untested:

Sub compiler()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim x As Range
Dim y As Range
Dim c as Range

Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")

Set x = ws2.Range("A1:Z1000").Find(What:=ws1.range("A1").value, _
        After:=ActiveCell, LookIn:=xlFormulas, _
        lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

if x is nothing then
    msgbox "Id not found on `" & ws2.Name & "` !"
    exit sub
end if

for each c in ws1.Range("A6:A11").Cells

    Set y = ws2.Range("A1:Z1000").Find(What:=c.value, After:=ActiveCell, _
            LookIn:=xlFormulas, lookat:=xlWhole, SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    If not y is nothing then
        x.entirerow.cells(y.column).value = c.offset(0,1).value
    else
        c.font.color=vbRed
    end if

next c

End Sub

Upvotes: 1

Related Questions