Conditional Loop Not Pasting As Desired

[ExcelRalph]

Hello,

I'm attempting to copy fields from two worksheets if a condition is met and paste into defined columns of a third worksheet "Sheet6".

The code correctly identifies the fields, however it appears that the loop resets after the a condition is not met. This seems to result in non consecutive rows on the third worksheet. I don't want any gaps in rows on "Sheet6".
Can you help? Or provide a more efficient code? Thank you!

GRE Excel Help.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S
14	Country Code	MAC	Account	AccountNumber	CPA	Original CPA	PID	Product Clusters	GSFA Customer ID	Currency	Product clusters to preserve (Rates and all other attributes)	Source PID	Effective Date	Divisor	Payment Terms	Billing Cycle	OMS Offer Required (Y/N)	OfferID	Special Instructions/Notes
15	(Sheet5)	(Sheet5)	(Sheet5)	(Sheet5)	117167	#N/A	New1	Product Clusters ABCD			None	N/A	5/1/2021	Non-Standard	45	Weekly	Y	15230-01	Example, No KAP action/push through to OMS.
Sheet2

GRE Excel Help.xlsm
	A	B	C	D	E	F	G	H	I	J	K
1	Country	MAC	Account Name	Account Number	CPA	PID	Product Clusters	GSFA Customer ID	Currency	In Scope?	Note
2	US	428	Customer DCA	2678651	995544	PUD00OREL	ProductsABC	TXNMC771602212		No
3	US	428	Customer ABC	756877776	117167	USD00OSNG	TD3rd;TDDom_Territories;TDExport;TDImport	USMC796692175	USD
4	US	428	Customer DCA	796692175	995544	USD00OSNG	TD3rd;TDDom_Territories;TDExport;TDImport	USMC796692175	USD
5	US	428	Customer ABC	845830910	117167	USD00OSNG	TD3rd;TDDom_Territories;TDExport;TDImport	USMC854198166	USD	No
6	US	428	Customer DCA	7654954	117167	PUD00OSNG	ProductsABC	PRMC854198166	USD
7	US	428	Customer ABC	8458309	117167	PUD00OSNG	ProductsABC	PRMC854198166	USD	No
8	US	428	Customer ABC	8461431	117167	PUD00OSNG	ProductsABC	PRMC771602212	USD	No
9
GRE As Is

GRE Excel Help.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S
2	Country	MAC	Account Name	Account Number	CPA	Original CPA	PID	Product Clusters	GSFA Customer ID	Currency	Product clusters to preserve (Rates and all other attributes)	Source PID	Effective Date	Divisor	Payment Terms	Billing Cycle	OMS Offer Required (Y/N)	OfferID	Special Instructions/Notes
3	US	428	Customer ABC	756877776	117167	117167	New1	Product Clusters ABCD	USMC796692175		None	N/A	5/1/2021	Non-Standard	45	Weekly	Y	15230-01	Example, No KAP action/push through to OMS.
4	US	428	Customer DCA	796692175	117167	995544	New1	Product Clusters ABCD	USMC796692175		None	N/A	5/1/2021	Non-Standard	45	Weekly	Y	15230-01	Example, No KAP action/push through to OMS.
5
6	US	428	Customer DCA	7654954	117167	117167	New1	Product Clusters ABCD	PRMC854198166		None	N/A	5/1/2021	Non-Standard	45	Weekly	Y	15230-01	Example, No KAP action/push through to OMS.
7
8
GRE To Be

 

[offthelip]

can you post your code with code tags not as picture, I could make a simple chage to get your code to work, but I don't want to have to retype all of it. To do this select your code in excel and copy it then select the vba symbol in edit box on this website and paste your code.

 

[ExcelRalph]

Hi, and thank you for your offer to help. Also just to note my Sheet5 = GRE As Is and Sheet6 = GRE To Be.

Sub GRE_To_Be_Section1()
    Dim UsdRws As Long, i As Long
    Dim CPA As Long
    
    
    
    
    
        CPA = Worksheets("Sheet2").Range("E15").Value
        UsdRws = Sheet5.Cells(Rows.Count, 1).End(xlUp).Row
        For i = 2 To UsdRws
            If Sheet5.Range("J" & i).Value = "" And Sheet5.Range("E" & i).Value = CPA Then
                Sheet5.Range("A" & i).Resize(, 4).Copy Sheet6.Cells(i, 1)
                Sheet5.Range("E" & i).Resize(, 1).Copy Sheet6.Cells(i, 6)
                Worksheets("Sheet2").Range("E15").Resize(, 1).Copy Sheet6.Cells(i, 5)
                Worksheets("Sheet2").Range("G15").Resize(, 13).Copy Sheet6.Cells(i, 7)
                Sheet5.Range("H" & i).Resize(, 1).Copy Sheet6.Cells(i, 9)
                              
            End If
        Next i
       

End Sub

 

[offthelip]

Thanks for the code, here is the quick modification get rid of the blanks row:

Sub GRE_To_Be_Section1()
    Dim UsdRws As Long, i As Long
    Dim CPA As Long
    Dim indi As Long
    
    
    
    
        CPA = Worksheets("Sheet2").Range("E15").Value
        UsdRws = Sheet5.Cells(Rows.Count, 1).End(xlUp).Row
        indi = 1
        For i = 2 To UsdRws
            If Sheet5.Range("J" & i).Value = "" And Sheet5.Range("E" & i).Value = CPA Then
                Sheet5.Range("A" & i).Resize(, 4).Copy Sheet6.Cells(indi, 1)
                Sheet5.Range("E" & i).Resize(, 1).Copy Sheet6.Cells(indi, 6)
                Worksheets("Sheet2").Range("E15").Resize(, 1).Copy Sheet6.Cells(indi, 5)
                Worksheets("Sheet2").Range("G15").Resize(, 13).Copy Sheet6.Cells(indi, 7)
                Sheet5.Range("H" & i).Resize(, 1).Copy Sheet6.Cells(indi, 9)
                indi = indi + 1
            End If
        Next i
       

End Sub

You can make the code much much faster if you have a large number of rows to process. This is by loading all of sheet 6 into a variant array, define an output array and then run the loop entirely in memory this will be about 1000 times faster. You can't use the resize method so you would have to create some additional loops. Then finally write the output array out to the worksheet

 

[ExcelRalph]

Thank you very much!

Since I was using a "Header Row" in row 2 of Sheet6, I modified the indi = 3 and it works perfectly.

Noted on the speed available with the array method and I will explore further. The final Sheet6 at times will have two sections so my focus had been on the top section.

Thank you again!