VBA to copy strings according to predefined markers (numbers)

smide

smide

Board Regular
Joined
Dec 20, 2015
Messages
164
Office Version
  1. 2016
Platform
  1. Windows
Hello.

In Sheet2, Column B (B3:B50) I have a strings which I need to copy in Sheet1 , Row 3 in cells B3,D3,F3, ... V3 and X3 (12 in total).

In Sheet2, Column G is so called "markers" Column because it contains markers/numbers for each product and those markers define copy position for each cell (copy position in Sheet1, row3).

So, if let say (in Sheet2) cell G3=1 than string from cell B3 (Sheet2) should be copied in B3 (Sheet1) and so on...

- IF some cell(s) in G column (G3:G50) is empty (without marker) than delete appropriate string in column B.
- IF Column G is completely empty than JUST copy first 12 strings from Sheet2 (B3:B14) into Sheet1 (B3,D3,F3,...X3).
(B3 to B3, B4 to D3 ...)

Example.

Sheet2


[TABLE="class: grid, align: center"]
<tbody>[TR]
[TD][/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]G[/TD]
[/TR]
[TR]
[TD="align: center"]1[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD="align: center"]home[/TD]
[TD="align: center"]3[/TD]
[/TR]
[TR]
[TD="align: center"]4[/TD]
[TD="align: center"]shop[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]5[/TD]
[TD="align: center"]mrexcel
[/TD]
[TD="align: center"]1[/TD]
[/TR]
[TR]
[TD="align: center"]6[/TD]
[TD="align: center"]pattern
[/TD]
[TD="align: center"]6[/TD]
[/TR]
[TR]
[TD="align: center"]7[/TD]
[TD="align: center"]question
[/TD]
[TD="align: center"]2[/TD]
[/TR]
[TR]
[TD="align: center"]8[/TD]
[TD="align: center"]product[/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]9[/TD]
[TD="align: center"]best
[/TD]
[TD="align: center"]5[/TD]
[/TR]
[TR]
[TD="align: center"]10[/TD]
[TD="align: center"]forward
[/TD]
[TD="align: center"]4[/TD]
[/TR]
[TR]
[TD="align: center"]11[/TD]
[TD="align: center"].....[/TD]
[TD="align: center"]....[/TD]
[/TR]
</tbody>[/TABLE]

Sheet1 (after macro run)

[TABLE="class: grid, align: center"]
<tbody>[TR]
[TD][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[TD="align: center"]D[/TD]
[TD="align: center"]E[/TD]
[TD="align: center"]F[/TD]
[TD="align: center"]G[/TD]
[TD="align: center"]H[/TD]
[TD="align: center"]I[/TD]
[TD="align: center"]J[/TD]
[TD="align: center"]K[/TD]
[TD="align: center"]L[/TD]
[TD="align: center"]M[/TD]
[TD="align: center"]N[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD][/TD]
[TD]mrexcel
[/TD]
[TD][/TD]
[TD]question
[/TD]
[TD][/TD]
[TD]home
[/TD]
[TD][/TD]
[TD]forward
[/TD]
[TD][/TD]
[TD]best
[/TD]
[TD][/TD]
[TD]pattern
[/TD]
[TD][/TD]
[TD]...[/TD]
[/TR]
</tbody>[/TABLE]

Sheet2 (after macro run)

[TABLE="class: grid, align: center"]
<tbody>[TR]
[TD="align: center"][/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]G[/TD]
[/TR]
[TR]
[TD="align: center"]1[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD="align: center"]home[/TD]
[TD="align: center"]3[/TD]
[/TR]
[TR]
[TD="align: center"]4[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]5[/TD]
[TD="align: center"]mrexcel[/TD]
[TD="align: center"]1[/TD]
[/TR]
[TR]
[TD="align: center"]6[/TD]
[TD="align: center"]pattern[/TD]
[TD="align: center"]6[/TD]
[/TR]
[TR]
[TD="align: center"]7[/TD]
[TD="align: center"]question[/TD]
[TD="align: center"]2[/TD]
[/TR]
[TR]
[TD="align: center"]8[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]9[/TD]
[TD="align: center"]best[/TD]
[TD="align: center"]5[/TD]
[/TR]
[TR]
[TD="align: center"]10[/TD]
[TD="align: center"]forward[/TD]
[TD="align: center"]4[/TD]
[/TR]
[TR]
[TD="align: center"]11[/TD]
[TD="align: center"]....[/TD]
[TD="align: center"][/TD]
[/TR]
</tbody>[/TABLE]
 
Last edited:

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.
Sort by date Sort by votes
[TABLE="******* 1219"]
<colgroup><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col></colgroup><tbody>[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]In Sheet2, Column B (B3:B50) I have a strings which I need to copy in Sheet1 , Row 3 in cells B3,D3,F3, ... V3 and X3 (12 in total).[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]home[/TD]
[TD]3[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]In Sheet2, Column G is so called "markers" Column because it contains markers/numbers for each product and those markers define copy position for each cell (copy position in Sheet1, row3). [/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD] [/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]mrexcel[/TD]
[TD]1[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]So, if let say (in Sheet2) cell G3=1 than string from cell B3 (Sheet2) should be copied in B3 (Sheet1) and so on...[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]pattern[/TD]
[TD]6[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]question[/TD]
[TD]2[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]- IF some cell(s) in G column (G3:G50) is empty (without marker) than delete appropriate string in column B.[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD] [/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]- IF Column G is completely empty than JUST copy first 12 strings from Sheet2 (B3:B14) into Sheet1 (B3,D3,F3,...X3).[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]9[/TD]
[TD]best[/TD]
[TD]5[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD](B3 to B3, B4 to D3 ...)[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]10[/TD]
[TD]forward[/TD]
[TD]4[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]this macro does it - I think…[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]For j = 3 To 10[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD] If Cells(j, 3) = "" Then Cells(j, 2) = Cells(1, 1)[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD] Next j[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]....[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD] ccol = 2[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD] num = 1[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]20 For k = 3 To 10[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD] If Cells(k, 3) = num Then Cells(26, ccol) = Cells(k, 2): num = num + 1: ccol = ccol + 2: GoTo 20[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD] Next k[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]End Sub[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]col B[/TD]
[TD][/TD]
[TD]D[/TD]
[TD][/TD]
[TD]F[/TD]
[TD][/TD]
[TD]H[/TD]
[TD][/TD]
[TD]J[/TD]
[TD][/TD]
[TD]L[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]mrexcel[/TD]
[TD][/TD]
[TD]question[/TD]
[TD][/TD]
[TD]home[/TD]
[TD][/TD]
[TD]forward[/TD]
[TD][/TD]
[TD]best[/TD]
[TD][/TD]
[TD]pattern[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
See if this code does what you want...
Code: 
[table="******* 500"]
[tr]
	[td]Sub ProductMarkers()
  Dim UnusedColumn As Long, LastRow As Long, NewLastRow As Long
  UnusedColumn = Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column + 1
  LastRow = Cells(Rows.Count, "B").End(xlUp).Row
  Application.ScreenUpdating = False
  Cells(3, UnusedColumn).Resize(LastRow - 2) = Evaluate("ROW(3:" & LastRow & ")-2")
  Range("A3", Cells(LastRow, UnusedColumn)).Sort Range("G3"), xlAscending
  NewLastRow = Cells(Rows.Count, "G").End(xlUp).Row
  Sheets("Sheet1").Range("B3").Resize(, 2 * (NewLastRow - 2) - 1) = Split(Join(Application.Transpose(Range("B3").Resize(NewLastRow - 2)), Chr(1) & Chr(1)), Chr(1))
  Range("A3", Cells(LastRow, UnusedColumn)).Sort Cells(3, UnusedColumn), xlAscending
  Columns(UnusedColumn).Delete
  Application.ScreenUpdating = True
  Range("G3:G" & LastRow).SpecialCells(xlBlanks).EntireRow.Clear
End Sub[/td]
[/tr]
[/table]
 
Upvote 0
Rick Rothstein said:
See if this code does what you want...
Code: 
[TABLE]
<tbody>[TR]
[TD]Sub ProductMarkers()
  Dim UnusedColumn As Long, LastRow As Long, NewLastRow As Long
  UnusedColumn = Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column + 1
  LastRow = Cells(Rows.Count, "B").End(xlUp).Row
  Application.ScreenUpdating = False
  Cells(3, UnusedColumn).Resize(LastRow - 2) = Evaluate("ROW(3:" & LastRow & ")-2")
  Range("A3", Cells(LastRow, UnusedColumn)).Sort Range("G3"), xlAscending
  NewLastRow = Cells(Rows.Count, "G").End(xlUp).Row
  Sheets("Sheet1").Range("B3").Resize(, 2 * (NewLastRow - 2) - 1) = Split(Join(Application.Transpose(Range("B3").Resize(NewLastRow - 2)), Chr(1) & Chr(1)), Chr(1))
  Range("A3", Cells(LastRow, UnusedColumn)).Sort Cells(3, UnusedColumn), xlAscending
  Columns(UnusedColumn).Delete
  Application.ScreenUpdating = True
  Range("G3:G" & LastRow).SpecialCells(xlBlanks).EntireRow.Clear
End Sub[/TD]
[/TR]
</tbody>[/TABLE]
Click to expand...

That's exactly what I wanted.
Thank you! ;)
 
Upvote 0
You must log in or register to reply here.

Similar threads

tsroque
  • Question Question
Excel VBA to Copy Range, Open Gmail and Paste in Body
Replies
0
Views
261
tsroque
tsroque
D
  • Question Question
Generating Reports in Word Using Data in Excel
Replies
1
Views
284
Dan_W
D
P
  • Question Question
Automating copying of columns within same sheet in excel using VBA.
Replies
1
Views
623
MountainFog
M
S
  • Solved
Copy values only without specific column formats VBA
Replies
9
Views
360
sofas
S
V
  • Solved
row to column - vba or code or formula
Replies
2
Views
255
Vishaal
V

Forum statistics

Threads
1,223,099
Messages
6,170,112
Members
452,302
Latest member
TaMere

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