Macro that transposes and concatenates

C

coops711

New Member
Joined
Jul 11, 2017
Messages
5
Hello

I am trying to write a macro that joins strings of text together whilst also transposing. I'll try provide an example of what I'm after:

So here is table 1, where we write the campaign name, the ad group name and its associated keyword(s).


A B C D[TABLE="width: 676"]
<colgroup><col><col><col><col></colgroup><tbody>[TR]
[TD]Campaign Name:[/TD]
[TD]Campaign 1[/TD]
[TD]Campaign 2[/TD]
[TD]Campaign 3[/TD]
[/TR]
[TR]
[TD]Adgroup Name:[/TD]
[TD]Ad group 1[/TD]
[TD]Ad group 2[/TD]
[TD]Ad group 3[/TD]
[/TR]
[TR]
[TD]Keywords:[/TD]
[TD]Shoes[/TD]
[TD]dresses[/TD]
[TD]towels[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD]blue shoes[/TD]
[TD]blue dresses[/TD]
[TD]blue towels[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]pink towels
red towels
[/TD]
[/TR]
[TR]
[TD]


What I want is a macro that will assign each keyword with its respective campaign name/ad group, per line, as shown:


[/TD]
[TD][/TD]
[TD][/TD]
[TD]


[/TD]
[/TR]
</tbody>[/TABLE]

A B C
[TABLE="width: 488"]
<colgroup><col><col><col></colgroup><tbody>[TR]
[TD]Campaign Name[/TD]
[TD]Adgroup name[/TD]
[TD]Keyword[/TD]
[/TR]
[TR]
[TD]Campaign 1[/TD]
[TD]Ad group 1[/TD]
[TD]Shoes[/TD]
[/TR]
[TR]
[TD]Campaign 1[/TD]
[TD]Ad group 1[/TD]
[TD]blue shoes[/TD]
[/TR]
[TR]
[TD]Campaign 2[/TD]
[TD]Ad group 2[/TD]
[TD]dresses[/TD]
[/TR]
[TR]
[TD]Campaign 2[/TD]
[TD]Ad group 2[/TD]
[TD]blue dresses[/TD]
[/TR]
[TR]
[TD]Campaign 3[/TD]
[TD]Ad group 3[/TD]
[TD]towels[/TD]
[/TR]
[TR]
[TD]Campaign 3[/TD]
[TD]Ad group 3[/TD]
[TD]blue towels[/TD]
[/TR]
[TR]
[TD]Campaign 3[/TD]
[TD]Ad group 3[/TD]
[TD]pink towels[/TD]
[/TR]
[TR]
[TD]Campaign 3[/TD]
[TD]Ad group 3[/TD]
[TD]red towels[/TD]
[/TR]
</tbody>[/TABLE]


Thanks for your help!
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Sort by date Sort by votes
Try this in a copy of your workbook.
Code: 
Sub CampaignDetails()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, r As Long, uba As Long
  
  With Range("A1").CurrentRegion
    a = .Value
    uba = UBound(a)
    ReDim b(1 To Rows.Count, 1 To 3)
    For j = 2 To UBound(a, 2)
      i = 2
      Do
        i = i + 1
        If a(i, j) = "" Then
          i = uba
        Else
          r = r + 1
          b(r, 1) = a(1, j)
          b(r, 2) = a(2, j)
          b(r, 3) = a(i, j)
        End If
      Loop Until i = uba
    Next j
    Application.ScreenUpdating = False
    With .Offset(, .Columns.Count + 1).Resize(, 3)
      .Value = Array("Campaign Name", "Adgroup name", "Keyword")
      .Offset(1).Resize(r).Value = b
      .EntireColumn.AutoFit
    End With
    Application.ScreenUpdating = True
  End With
End Sub

My sample data (A:D) and results (F:H)


Book1
ABCDEFGH
1Campaign Name:Campaign 1Campaign 2Campaign 3Campaign NameAdgroup nameKeyword
2Adgroup Name:Ad group 1Ad group 2Ad group 3Campaign 1Ad group 1Shoes
3Keywords:ShoesdressestowelsCampaign 1Ad group 1blue shoes
4blue shoesblue dressesblue towelsCampaign 2Ad group 2dresses
5pink towelsCampaign 2Ad group 2blue dresses
6red towelsCampaign 3Ad group 3towels
7Campaign 3Ad group 3blue towels
8Campaign 3Ad group 3pink towels
9Campaign 3Ad group 3red towels
Campaign
 
Upvote 0
Peter_SSs said:
Try this in a copy of your workbook.
Code: 
Sub CampaignDetails()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, r As Long, uba As Long
  
  With Range("A1").CurrentRegion
    a = .Value
    uba = UBound(a)
    ReDim b(1 To Rows.Count, 1 To 3)
    For j = 2 To UBound(a, 2)
      i = 2
      Do
        i = i + 1
        If a(i, j) = "" Then
          i = uba
        Else
          r = r + 1
          b(r, 1) = a(1, j)
          b(r, 2) = a(2, j)
          b(r, 3) = a(i, j)
        End If
      Loop Until i = uba
    Next j
    Application.ScreenUpdating = False
    With .Offset(, .Columns.Count + 1).Resize(, 3)
      .Value = Array("Campaign Name", "Adgroup name", "Keyword")
      .Offset(1).Resize(r).Value = b
      .EntireColumn.AutoFit
    End With
    Application.ScreenUpdating = True
  End With
End Sub

My sample data (A:D) and results (F:H)

ABCDEFGH
Campaign Name:Campaign 1Campaign 2Campaign 3Campaign NameAdgroup nameKeyword
Adgroup Name:Ad group 1Ad group 2Ad group 3Campaign 1Ad group 1Shoes
Keywords:ShoesdressestowelsCampaign 1Ad group 1blue shoes
blue shoesblue dressesblue towelsCampaign 2Ad group 2dresses
pink towelsCampaign 2Ad group 2blue dresses
red towelsCampaign 3Ad group 3towels
Campaign 3Ad group 3blue towels
Campaign 3Ad group 3pink towels
Campaign 3Ad group 3red towels

<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
[TD="align: center"]1[/TD]

[TD="align: right"][/TD]

[TD="align: center"]2[/TD]

[TD="align: right"][/TD]

[TD="align: center"]3[/TD]

[TD="align: right"][/TD]

[TD="align: center"]4[/TD]
[TD="align: right"][/TD]

[TD="align: right"][/TD]

[TD="align: center"]5[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: right"][/TD]

[TD="align: center"]6[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: right"][/TD]

[TD="align: center"]7[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]8[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]9[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

</tbody>
Campaign​
Click to expand...


This is great. Thanks - exactly what im looking for. I haven't done a macro like this before.


Could you please help me edit this in the following two ways:

1) I simplified the data slightly to make it easier to read, in the actual sheet there is a gap between the "campaign name" row and the other two rows.

Specifically, the campaign name row is at A14, the ad group name row is at A32, keyword row is at A33

2) Could the data be pasted into a new sheet?
 
Upvote 0
Best not to fully quote long posts as it makes the thread harder to read/navigate and just occupies storage space needlessly. If you want to quote, quote small, relevant parts only.

coops711 said:
Could you please help me edit this in the following two ways:

1) I simplified the data slightly to make it easier to read, in the actual sheet there is a gap between the "campaign name" row and the other two rows.

Specifically, the campaign name row is at A14, the ad group name row is at A32, keyword row is at A33

2) Could the data be pasted into a new sheet?
Click to expand...
Try this version with a copy of your workbook.

Code: 
Sub CampaignDetails_v2()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, r As Long, uba As Long, lr As Long
  
  lr = Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, SearchFormat:=False).Row
  a = Range("A14:A" & lr).Resize(, Cells(14, Columns.Count).End(xlToLeft).Column).Value
  uba = UBound(a)
  ReDim b(1 To Rows.Count, 1 To 3)
  For j = 2 To UBound(a, 2)
    i = 19
    Do
      i = i + 1
      If a(i, j) = "" Then
        i = uba
      Else
        r = r + 1
        b(r, 1) = a(1, j)
        b(r, 2) = a(19, j)
        b(r, 3) = a(i, j)
      End If
    Loop Until i = uba
  Next j
  Application.ScreenUpdating = False
  Sheets.Add After:=ActiveSheet
  With Range("A1:C1")
    .Value = Array("Campaign Name", "Adgroup name", "Keyword")
    .Offset(1).Resize(r).Value = b
    .EntireColumn.AutoFit
  End With
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

O
  • Question Question
Running through a Config and pulling out the relevant information using keywords into smaller sheets
Replies
0
Views
282
oitbc
O
An Quala
  • Question Question
Copy pasting templates while changing values from the control panel [VBA]
Replies
1
Views
412
An Quala
An Quala
S
  • Question Question
VBA code for adding new group of columns with 3 condictions from 2 dictionary and 1 array Then fill in data from value from original columns
Replies
1
Views
89
sijpie
sijpie
An Quala
  • Question Question
Delete the Entire Row if following conditions are TRUE in Excel VBA
Replies
4
Views
609
Peter_SSs
Peter_SSs
An Quala
  • Question Question
Error in the VBA Code
Replies
8
Views
944
rlv01
R

Forum statistics

Threads
1,223,214
Messages
6,170,774
Members
452,353
Latest member
strainu

Share this page

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
Back
Top