Copy and merge columns to new worksheet

[weijianhk]

I have a project I am working on for work. It involves 12 columns: Column A is the Country name (country name from A to Z), Column B is the country ID, Column C is the Subscriber count of a particular country. Column D, E and F, is the supplier name, cost, and conversion rate of a specific company called Yonitech. Column H, I and J are also the supplier name, cost and conversion rate of another specific company called Aliworld, Column K,L and M are also the supplier name, cost and conversion rate of the third company called Lanck.

Basically, company Yonitech has supplier options for the countries that they can cover, with the cost and conversion rate listed. Likewise for company Aliworld and Lanck as well.
The supplier names of all 3 companies can be different.

I'm trying to write VBA codes to copy the information to another worksheet, information on the new worksheet would be the country name, country ID, subscriber count, as well as supplier name, cost and conversion rate. So what i'm trying to achieve is to copy paste the supplier names, cost and conversion of Yonitech into the new worksheet, and if cells are blank, it will then look through the supplier options of 2nd company Aliworld and copy paste the supplier names, cost and conversion of Aliworld before it similarly do the same for Lanck also.
So the new worksheet should only have 6 columns - country name, country ID, subscriber count, supplier name, cost and conversion rate, in which the last 3 columns are a combination of supplier options from the three companies.

Any help would be greatly appreciated. Thank you.

 

[alansidman]

Instead of us having to type your data (guessing), please upload a sample of your data 8-10 records using XL2BB. Also then using XL2BB show us a mocked up solution. Be sure to use dummy names to protect confidentiality.

 

[weijianhk]

Instead of us having to type your data (guessing), please upload a sample of your data 8-10 records using XL2BB. Also then using XL2BB show us a mocked up solution. Be sure to use dummy names to protect confidentiality.

Hi, I'm sorry for that and yeps I have attached the mockups.

Current -

Overall view_ Operator overview per Supplier Product_v1.9.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P
2	MccMnc	Country	Region	Subregion	CM Op Name	Subscriber Count	Market Share %	Supplier product name	Cost	Conversion Rate	Supplier product name (1)	Cost (1)	Conversion Rate (1)	Supplier product name (2)	Cost (2)	Conversion Rate (2)
3	41201	Afghanistan	APAC	Southern Asia	AF - AWCC	3,900,856	20.09%							MessageBird Direct	0.0755
4	41220	Afghanistan	APAC	Southern Asia	AF - Roshan	6,203,700	31.95%							Antwerp Tech Direct	0.089
5	41240	Afghanistan	APAC	Southern Asia	AF - MTN	4,535,788	23.36%							MessageBird Direct	0.058
6	41250	Afghanistan	APAC	Southern Asia	AF - Etisalat	4,372,686	22.52%							Dexatel	0.056
7	41288	Afghanistan	APAC	Southern Asia	AF - Afghan Telecom	219,411	1.13%							MessageBird Direct	0.07
8	27602	Albania	Europe	Southern Europe	AL - Vodafone	1,021,492	44.85%				Apigate Axiata	0.074296764	86.56%
9	27601	Albania	Europe	Southern Europe	AL - Telekom Albania	1,016,026	44.61%
10	27603	Albania	Europe	Southern Europe	AL - Eagle	240,056	10.54%				Digicel Direct	0.033578979	79.47%
11	60301	Algeria	MENA	MENA	DZ - Mobilis	13,679,160	42.63%	Agile Telecom Directs	0.0795	64.08%				Dexatel	0.0789
12	60303	Algeria	MENA	MENA	DZ - Nedjma	9,405,024	29.31%	Agile Telecom Directs	0.054964607	41.44%				Agile Telecom Directs	0.055
13	60302	Algeria	MENA	MENA	DZ - Djezzy	9,000,714	28.05%	Telxira	0.0625	67.50%				Agile Telecom Directs	0.055
14	54411	American Samoa	APAC	Polynesia	AS - Bluesky	13,524	44.25%							SMS-MT	0.035
15	21303	Andorra	Europe	Southern Europe	AD - Mobiland	63,587	100.00%	Mitto Direct	0.04	60.70%
Cost Compare

Cells with Data Validation
Cell	Allow	Criteria
B3:B15	Custom	List

Expected output in a new worksheet -

Book3
	A	B	C	D	E	F	G	H	I	J
1	MccMnc	Country	Region	Subregion	CM Op Name	Subscriber Count	Market Share %	Supplier product name	Cost	Conversion Rate
2	41201	Afghanistan	APAC	Southern Asia	AF - AWCC	3,900,856	20.09%	MessageBird Direct	0.0755
3	41220	Afghanistan	APAC	Southern Asia	AF - Roshan	6,203,700	31.95%	Antwerp Tech Direct	0.089
4	41240	Afghanistan	APAC	Southern Asia	AF - MTN	4,535,788	23.36%	MessageBird Direct	0.058
5	41250	Afghanistan	APAC	Southern Asia	AF - Etisalat	4,372,686	22.52%	Dexatel	0.056
6	41288	Afghanistan	APAC	Southern Asia	AF - Afghan Telecom	219,411	1.13%	MessageBird Direct	0.07
7	27602	Albania	Europe	Southern Europe	AL - Vodafone	1,021,492	44.85%	Apigate Axiata	0.074297	86.56%
8	27601	Albania	Europe	Southern Europe	AL - Telekom Albania	1,016,026	44.61%
9	27603	Albania	Europe	Southern Europe	AL - Eagle	240,056	10.54%	Digicel Direct	0.033579	79.47%
10	60301	Algeria	MENA	MENA	DZ - Mobilis	13,679,160	42.63%	Agile Telecom Directs	0.0795	64.08%
11	60303	Algeria	MENA	MENA	DZ - Nedjma	9,405,024	29.31%	Agile Telecom Directs	0.054965	41.44%
12	60302	Algeria	MENA	MENA	DZ - Djezzy	9,000,714	28.05%	Telxira	0.0625	67.50%
13	54411	American Samoa	APAC	Polynesia	AS - Bluesky	13,524	44.25%
14	21303	Andorra	Europe	Southern Europe	AD - Mobiland	63,587	100.00%	Mitto Direct	0.04	60.70%
15	63102	Angola	Africa	Middle Africa	AO - Unitel	10,503,683	71.81%
Sheet1

Cells with Data Validation
Cell	Allow	Criteria
B2:B15	Custom	List

 

[Fluff]

How about

Sub weijianhk()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long
   
   With Sheets("Cost Compare")
      Ary = .Range("A2:P" & .Range("A" & Rows.Count).End(xlUp).Row).Value2
   End With
   ReDim Nary(1 To UBound(Ary), 1 To 10)
   For r = 1 To UBound(Ary)
      For c = 1 To 7
         Nary(r, c) = Ary(r, c)
      Next c
      For c = 8 To 16 Step 3
         If Ary(r, c) <> "" Then
            Nary(r, 8) = Ary(r, c)
            Nary(r, 9) = Ary(r, c + 1)
            Nary(r, 10) = Ary(r, c + 2)
            Exit For
         End If
      Next c
   Next r
   Sheets("Sheet1").Range("A1").Resize(UBound(Ary), 10).Value = Nary
End Sub

 

[weijianhk]

How about

Sub weijianhk()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long
  
   With Sheets("Cost Compare")
      Ary = .Range("A2:P" & .Range("A" & Rows.Count).End(xlUp).Row).Value2
   End With
   ReDim Nary(1 To UBound(Ary), 1 To 10)
   For r = 1 To UBound(Ary)
      For c = 1 To 7
         Nary(r, c) = Ary(r, c)
      Next c
      For c = 8 To 16 Step 3
         If Ary(r, c) <> "" Then
            Nary(r, 8) = Ary(r, c)
            Nary(r, 9) = Ary(r, c + 1)
            Nary(r, 10) = Ary(r, c + 2)
            Exit For
         End If
      Next c
   Next r
   Sheets("Sheet1").Range("A1").Resize(UBound(Ary), 10).Value = Nary
End Sub

Oh wow, you're a star! I'm really grateful for your fast turnaround and help, it works perfect!
I'm trying to understand the code, what is the main purpose of Ubound?

By the way, can you please kindly suggest how can I have a new column in the new worksheet which looks at the "weighted average" i.e. Cost * Market Share?

Thanks a ton!

 

[Fluff]

For the extra column use

Sub weijianhk()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long
   
   With Sheets("lists")
      Ary = .Range("A2:P" & .Range("A" & Rows.Count).End(xlUp).Row).Value2
   End With
   ReDim Nary(1 To UBound(Ary), 1 To 11)
   For r = 1 To UBound(Ary)
      For c = 1 To 7
         Nary(r, c) = Ary(r, c)
      Next c
      For c = 8 To 16 Step 3
         If Ary(r, c) <> "" Then
            Nary(r, 8) = Ary(r, c)
            Nary(r, 9) = Ary(r, c + 1)
            Nary(r, 10) = Ary(r, c + 2)
            If r > 1 Then Nary(r, 11) = Nary(r, 9) * Nary(r, 7)
            Exit For
         End If
      Next c
   Next r
   Sheets("Sheet1").Range("A1").Resize(UBound(Ary), 11).Value = Nary
End Sub

Ubound returns the upper bound of an array UBound function (Visual Basic for Applications)