MATCHING 2 COLUMN AND PUT INTO TEMPLATE SHEET

sal21

Active Member
Joined
Apr 1, 2002
Messages
250
I have this 2 sheets:

GAF
CORPORATE

How to matching range H:N into CORPORATE with the column H in GAF and when the value into range H:N is found in column H of GAF insert the line into template the value of cells..

Example:
Into range H2:N2 of CORPORATE are present: 1, 2, 3, 4, 6, 7, 15
into column H of sheet GAF are present many cells with the same value 1, 2, 3, 4, 6, 7, 15

Copy all line matched in TEMPLATE

Finished the first range of matching go to next line of CORPORATE range H3:N£ clear the value into TEMPLATE amnd insert the new value amtched with the same tecinque...

Do until the value in E of CORPORATE is blank...

Attached a TEMPLATE with the value of first rangeH2:N2 of CORPORATE

hope i am clear.:)
Attaced example

http://www.mytempdir.com/970855
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.

agihcam

Well-known Member
Joined
Jan 16, 2006
Messages
1,624
Hi -

try this;
Code:
Sub match_h()
Dim i, ii, iii As Long
Sheets("TEMPLATE").Columns("a").NumberFormat = "@"
Application.ScreenUpdating = False
For i = 2 To Sheets("CORPORATE").Range("h" & Rows.Count).End(xlUp).Row
    ii = Sheets("CORPORATE").Cells(i, "h").End(xlToRight).Column
        For iii = Sheets("CORPORATE").Cells(i, "h").Column To ii
            With Sheets("GAF").Columns("h")
                Set c = .Find(Sheets("CORPORATE").Cells(i, iii).Value, , , xlWhole)
                    If Not c Is Nothing Then
                        f = c.Address
                        Do
                            Sheets("TEMPLATE").Range("a" & Rows.Count).End(xlUp).Offset(1).Resize(, 2).Value = c.Offset(, -7).Resize(, 2).Value
                            Sheets("TEMPLATE").Range("a" & Rows.Count).End(xlUp).Offset(, 2).Resize(, 8).Value = c.Offset(, -4).Resize(, 8).Value
                            Sheets("TEMPLATE").Range("a" & Rows.Count).End(xlUp).Offset(, 10).Resize(, 3).Value = c.Offset(, 6).Resize(, 3).Value
                        Set c = .FindNext(c)
                        Loop Until f = c.Address
                    End If
                    
            End With
        Next
Next
Application.ScreenUpdating = False
End Sub
 

sal21

Active Member
Joined
Apr 1, 2002
Messages
250
Hi -

try this;
Code:
Sub match_h()
Dim i, ii, iii As Long
Sheets("TEMPLATE").Columns("a").NumberFormat = "@"
Application.ScreenUpdating = False
For i = 2 To Sheets("CORPORATE").Range("h" & Rows.Count).End(xlUp).Row
    ii = Sheets("CORPORATE").Cells(i, "h").End(xlToRight).Column
        For iii = Sheets("CORPORATE").Cells(i, "h").Column To ii
            With Sheets("GAF").Columns("h")
                Set c = .Find(Sheets("CORPORATE").Cells(i, iii).Value, , , xlWhole)
                    If Not c Is Nothing Then
                        f = c.Address
                        Do
                            Sheets("TEMPLATE").Range("a" & Rows.Count).End(xlUp).Offset(1).Resize(, 2).Value = c.Offset(, -7).Resize(, 2).Value
                            Sheets("TEMPLATE").Range("a" & Rows.Count).End(xlUp).Offset(, 2).Resize(, 8).Value = c.Offset(, -4).Resize(, 8).Value
                            Sheets("TEMPLATE").Range("a" & Rows.Count).End(xlUp).Offset(, 10).Resize(, 3).Value = c.Offset(, 6).Resize(, 3).Value
                        Set c = .FindNext(c)
                        Loop Until f = c.Address
                    End If
                    
            End With
        Next
Next
Application.ScreenUpdating = False
End Sub

two note:
note 1) How to have inderstand me in "one shot" my english is terrible!, for this sure you are a Wizard.:)
note 2) The code is perfect, and work very fine!

Caffe and Pizza for you from Napoli, hope to se you on my post:)
Tks.
Sal.
 

agihcam

Well-known Member
Joined
Jan 16, 2006
Messages
1,624
thanks for the compliment.

it's not a matter of how good or bad your english is, it's how you explain it fully and supported by a good sample data.
 

sal21

Active Member
Joined
Apr 1, 2002
Messages
250

ADVERTISEMENT

thanks for the compliment.

it's not a matter of how good or bad your english is, it's how you explain it fully and supported by a good sample data.

.. no tks for compliment, are right!
 

sal21

Active Member
Joined
Apr 1, 2002
Messages
250
Hi -

try this;
Code:
Sub match_h()
Dim i, ii, iii As Long
Sheets("TEMPLATE").Columns("a").NumberFormat = "@"
Application.ScreenUpdating = False
For i = 2 To Sheets("CORPORATE").Range("h" & Rows.Count).End(xlUp).Row
    ii = Sheets("CORPORATE").Cells(i, "h").End(xlToRight).Column
        For iii = Sheets("CORPORATE").Cells(i, "h").Column To ii
            With Sheets("GAF").Columns("h")
                Set c = .Find(Sheets("CORPORATE").Cells(i, iii).Value, , , xlWhole)
                    If Not c Is Nothing Then
                        f = c.Address
                        Do
                            Sheets("TEMPLATE").Range("a" & Rows.Count).End(xlUp).Offset(1).Resize(, 2).Value = c.Offset(, -7).Resize(, 2).Value
                            Sheets("TEMPLATE").Range("a" & Rows.Count).End(xlUp).Offset(, 2).Resize(, 8).Value = c.Offset(, -4).Resize(, 8).Value
                            Sheets("TEMPLATE").Range("a" & Rows.Count).End(xlUp).Offset(, 10).Resize(, 3).Value = c.Offset(, 6).Resize(, 3).Value
                        Set c = .FindNext(c)
                        Loop Until f = c.Address
                    End If
                    
            End With
        Next
Next
Application.ScreenUpdating = False
End Sub
but with the same macro is possible to insert another filter with column F of sheet RETAIL_POE and column D of GAF (maitain the rest of code with condition of first macro), use the same sheet GAF to matching

http://www.mytempdir.com/974197

Tks...
Sal.
 

agihcam

Well-known Member
Joined
Jan 16, 2006
Messages
1,624

ADVERTISEMENT

then where would you want to put the matching data from sheet RETAIL_POE and GAF? if this will go also to TEMPLATE sheet, then try;
Code:
Sub match_h()
Dim i, ii, iii, v As Long
Sheets("TEMPLATE").Columns("a").NumberFormat = "@"
Application.ScreenUpdating = False
For i = 2 To Sheets("CORPORATE").Range("h" & Rows.Count).End(xlUp).Row
    ii = Sheets("CORPORATE").Cells(i, "h").End(xlToRight).Column
        For iii = Sheets("CORPORATE").Cells(i, "h").Column To ii
            With Sheets("GAF").Columns("h")
                Set c = .Find(Sheets("CORPORATE").Cells(i, iii).Value, , , xlWhole)
                    If Not c Is Nothing Then
                        f = c.Address
                        Do
                            Sheets("TEMPLATE").Range("a" & Rows.Count).End(xlUp).Offset(1).Resize(, 2).Value = c.Offset(, -7).Resize(, 2).Value
                            Sheets("TEMPLATE").Range("a" & Rows.Count).End(xlUp).Offset(, 2).Resize(, 8).Value = c.Offset(, -4).Resize(, 8).Value
                            Sheets("TEMPLATE").Range("a" & Rows.Count).End(xlUp).Offset(, 10).Resize(, 3).Value = c.Offset(, 6).Resize(, 3).Value
                        Set c = .FindNext(c)
                        Loop Until f = c.Address
                    End If
                    
            End With
        Next
Next

'macth RETAIL_POE against GAF
For v = 2 To Sheets("RETAIL_POE").Range("f" & Rows.Count).End(xlUp).Row
            With Sheets("GAF").Columns("d")
                Set c = .Find(Sheets("RETAIL_POE").Cells(v, "f").Value, , , xlWhole)
                    If Not c Is Nothing Then
                        f = c.Address
                        Do
                            Sheets("TEMPLATE").Range("a" & Rows.Count).End(xlUp).Offset(1).Resize(, 2).Value = c.Offset(, -3).Resize(, 2).Value
                            Sheets("TEMPLATE").Range("a" & Rows.Count).End(xlUp).Offset(, 2).Resize(, 8).Value = c.Resize(, 8).Value
                            Sheets("TEMPLATE").Range("a" & Rows.Count).End(xlUp).Offset(, 10).Resize(, 3).Value = c.Offset(, 10).Resize(, 3).Value
                        Set c = .FindNext(c)
                        Loop Until f = c.Address
                    End If
                    
            End With
Next
Application.ScreenUpdating = False
End Sub
 

sal21

Active Member
Joined
Apr 1, 2002
Messages
250
then where would you want to put the matching data from sheet RETAIL_POE and GAF? if this will go also to TEMPLATE sheet, then try;
Code:
Sub match_h()
Dim i, ii, iii, v As Long
Sheets("TEMPLATE").Columns("a").NumberFormat = "@"
Application.ScreenUpdating = False
For i = 2 To Sheets("CORPORATE").Range("h" & Rows.Count).End(xlUp).Row
    ii = Sheets("CORPORATE").Cells(i, "h").End(xlToRight).Column
        For iii = Sheets("CORPORATE").Cells(i, "h").Column To ii
            With Sheets("GAF").Columns("h")
                Set c = .Find(Sheets("CORPORATE").Cells(i, iii).Value, , , xlWhole)
                    If Not c Is Nothing Then
                        f = c.Address
                        Do
                            Sheets("TEMPLATE").Range("a" & Rows.Count).End(xlUp).Offset(1).Resize(, 2).Value = c.Offset(, -7).Resize(, 2).Value
                            Sheets("TEMPLATE").Range("a" & Rows.Count).End(xlUp).Offset(, 2).Resize(, 8).Value = c.Offset(, -4).Resize(, 8).Value
                            Sheets("TEMPLATE").Range("a" & Rows.Count).End(xlUp).Offset(, 10).Resize(, 3).Value = c.Offset(, 6).Resize(, 3).Value
                        Set c = .FindNext(c)
                        Loop Until f = c.Address
                    End If
                    
            End With
        Next
Next

'macth RETAIL_POE against GAF
For v = 2 To Sheets("RETAIL_POE").Range("f" & Rows.Count).End(xlUp).Row
            With Sheets("GAF").Columns("d")
                Set c = .Find(Sheets("RETAIL_POE").Cells(v, "f").Value, , , xlWhole)
                    If Not c Is Nothing Then
                        f = c.Address
                        Do
                            Sheets("TEMPLATE").Range("a" & Rows.Count).End(xlUp).Offset(1).Resize(, 2).Value = c.Offset(, -3).Resize(, 2).Value
                            Sheets("TEMPLATE").Range("a" & Rows.Count).End(xlUp).Offset(, 2).Resize(, 8).Value = c.Resize(, 8).Value
                            Sheets("TEMPLATE").Range("a" & Rows.Count).End(xlUp).Offset(, 10).Resize(, 3).Value = c.Offset(, 10).Resize(, 3).Value
                        Set c = .FindNext(c)
                        Loop Until f = c.Address
                    End If
                    
            End With
Next
Application.ScreenUpdating = False
End Sub

tks work great!
But based the new code is possible to show a msgbox when the first block with the same idenx in D in sheet RETAIL_POE is copied in TEMPLATE...

Example:

copy in TEMPLATE do until the id change in coumn D in sheet RETAIL_POE after show the msgbox "block for OI16910 copied", go to the next id copy all in TEMPLATE show msgbox "block for OI24379 copied", got the nex block ecc...


attached new file:
http://www.mytempdir.com/975324
 

agihcam

Well-known Member
Joined
Jan 16, 2006
Messages
1,624
you mean like this(untested);
Code:
Sub match_h() 
Dim i, ii, iii, v As Long 
Sheets("TEMPLATE").Columns("a").NumberFormat = "@" 
Application.ScreenUpdating = False 
For i = 2 To Sheets("CORPORATE").Range("h" & Rows.Count).End(xlUp).Row 
    ii = Sheets("CORPORATE").Cells(i, "h").End(xlToRight).Column 
        For iii = Sheets("CORPORATE").Cells(i, "h").Column To ii 
            With Sheets("GAF").Columns("h") 
                Set c = .Find(Sheets("CORPORATE").Cells(i, iii).Value, , , xlWhole) 
                    If Not c Is Nothing Then 
                        f = c.Address 
                        Do 
                            Sheets("TEMPLATE").Range("a" & Rows.Count).End(xlUp).Offset(1).Resize(, 2).Value = c.Offset(, -7).Resize(, 2).Value 
                            Sheets("TEMPLATE").Range("a" & Rows.Count).End(xlUp).Offset(, 2).Resize(, 8).Value = c.Offset(, -4).Resize(, 8).Value 
                            Sheets("TEMPLATE").Range("a" & Rows.Count).End(xlUp).Offset(, 10).Resize(, 3).Value = c.Offset(, 6).Resize(, 3).Value 
                        Set c = .FindNext(c) 
                        Loop Until f = c.Address 
                    End If 
                    
            End With 
        Next 
Next 

'macth RETAIL_POE against GAF 
For v = 2 To Sheets("RETAIL_POE").Range("f" & Rows.Count).End(xlUp).Row 
            With Sheets("GAF").Columns("d") 
                Set c = .Find(Sheets("RETAIL_POE").Cells(v, "f").Value, , , xlWhole) 
                    If Not c Is Nothing Then 
                        f = c.Address 
                        Do 
                            Sheets("TEMPLATE").Range("a" & Rows.Count).End(xlUp).Offset(1).Resize(, 2).Value = c.Offset(, -3).Resize(, 2).Value 
                            Sheets("TEMPLATE").Range("a" & Rows.Count).End(xlUp).Offset(, 2).Resize(, 8).Value = c.Resize(, 8).Value 
                            Sheets("TEMPLATE").Range("a" & Rows.Count).End(xlUp).Offset(, 10).Resize(, 3).Value = c.Offset(, 10).Resize(, 3).Value 
                        Set c = .FindNext(c) 
                        Loop Until f = c.Address 
                    End If 
                    
            End With 
if sheets("RETAIL_POE").cells(v+1,"d").value <> sheets("RETAIL_POE").cells(v,"d").value then
msgbox "Block for " & sheets("RETAIL_POE").cells(v,"d").value & " copied",vbinformation+vbokonly,"End of Block"
end if
Next 
Application.ScreenUpdating = False 
End Sub
 

sal21

Active Member
Joined
Apr 1, 2002
Messages
250
you mean like this(untested);
Code:
Sub match_h() 
Dim i, ii, iii, v As Long 
Sheets("TEMPLATE").Columns("a").NumberFormat = "@" 
Application.ScreenUpdating = False 
For i = 2 To Sheets("CORPORATE").Range("h" & Rows.Count).End(xlUp).Row 
    ii = Sheets("CORPORATE").Cells(i, "h").End(xlToRight).Column 
        For iii = Sheets("CORPORATE").Cells(i, "h").Column To ii 
            With Sheets("GAF").Columns("h") 
                Set c = .Find(Sheets("CORPORATE").Cells(i, iii).Value, , , xlWhole) 
                    If Not c Is Nothing Then 
                        f = c.Address 
                        Do 
                            Sheets("TEMPLATE").Range("a" & Rows.Count).End(xlUp).Offset(1).Resize(, 2).Value = c.Offset(, -7).Resize(, 2).Value 
                            Sheets("TEMPLATE").Range("a" & Rows.Count).End(xlUp).Offset(, 2).Resize(, 8).Value = c.Offset(, -4).Resize(, 8).Value 
                            Sheets("TEMPLATE").Range("a" & Rows.Count).End(xlUp).Offset(, 10).Resize(, 3).Value = c.Offset(, 6).Resize(, 3).Value 
                        Set c = .FindNext(c) 
                        Loop Until f = c.Address 
                    End If 
                    
            End With 
        Next 
Next 

'macth RETAIL_POE against GAF 
For v = 2 To Sheets("RETAIL_POE").Range("f" & Rows.Count).End(xlUp).Row 
            With Sheets("GAF").Columns("d") 
                Set c = .Find(Sheets("RETAIL_POE").Cells(v, "f").Value, , , xlWhole) 
                    If Not c Is Nothing Then 
                        f = c.Address 
                        Do 
                            Sheets("TEMPLATE").Range("a" & Rows.Count).End(xlUp).Offset(1).Resize(, 2).Value = c.Offset(, -3).Resize(, 2).Value 
                            Sheets("TEMPLATE").Range("a" & Rows.Count).End(xlUp).Offset(, 2).Resize(, 8).Value = c.Resize(, 8).Value 
                            Sheets("TEMPLATE").Range("a" & Rows.Count).End(xlUp).Offset(, 10).Resize(, 3).Value = c.Offset(, 10).Resize(, 3).Value 
                        Set c = .FindNext(c) 
                        Loop Until f = c.Address 
                    End If 
                    
            End With 
if sheets("RETAIL_POE").cells(v+1,"d").value <> sheets("RETAIL_POE").cells(v,"d").value then
msgbox "Block for " & sheets("RETAIL_POE").cells(v,"d").value & " copied",vbinformation+vbokonly,"End of Block"
end if
Next 
Application.ScreenUpdating = False 
End Sub
Hi agihcam, tks for second part of code...
But my idea is two macro, one for CORPORATE and one RETAIL_POE...

Refered second part of code:
the first for sheet CORPORATE and second for sheet RETAIL_POE....

Ok for msgbox for each vlaue in D from RETAIL_POE
work nice.
 

Forum statistics

Threads
1,136,600
Messages
5,676,727
Members
419,647
Latest member
usas12gthr

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top