Create list with VBA

G

Giancar

Board Regular
Joined
Nov 29, 2017
Messages
52
Hi,

I would like a VBA code to:
1) Create a New sheet called "Ranking"
2) In this new sheet, I want to create a list.
In A1 I want to have "Ranking", B1 I want to have "Category, C1 I want to have "ID", D1 I want to have "Name"

From A2 till A1010 a list of numbers: A2 I want to have 1, A3 I want to have 2, A4 I want to have 3, etc.

From B2 till B54 I want the following list: DOM1, PKG, DOM1, INT, DOM1, EU, DOM1, PKG, DOM1, INT, DOM1, EU, DOM1, PKG, DOM1, INT, DOM1, EU, DOM2, PKG, DOM2, INT, DOM2, EU, DOM2, PKG, DOM2, INT, DOM2, EU, DOM2, PKG, DOM2, INT, DOM2, EU, DOM3, PKG, DOM3, INT, DOM3, EU, DOM3, PKG, DOM3, INT, DOM3, EU, DOM3, PKG, DOM3, INT, DOM3, EU.

B2:B54, then needs to be copy and pasted immediately below till row 1010.

Any help?


Any help?
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
Sort by date Sort by votes
Here is macro recorder version that seems to do what you want.

Copy the long list to cell C2, (I copied it from your post to cell C2).

Then run this code.

Howard

Code: 
Sub Macro3()
'
' Macro3 Macro
'
'
    Range("C3").Select
    ActiveCell.FormulaR1C1 = "=SUBSTITUTE(R[-1]C,"" "","""")"
    Range("C3").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.TextToColumns Destination:=Range("C3"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
        (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), _
        Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array( _
        33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), _
        Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array( _
        46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), _
        Array(53, 1), Array(54, 1)), TrailingMinusNumbers:=True
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    ActiveWindow.LargeScroll ToRight:=-2
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    ActiveWindow.SmallScroll Down:=45
    Application.CutCopyMode = False
    Selection.AutoFill Destination:=Range("B2:B1010"), Type:=xlFillDefault
   ' Range("B2:B1010").Select
   
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "2"
    Range("A2:A3").Select
    Selection.AutoFill Destination:=Range("A2:A1010")
  '  Range("A2:A1010").Select
    Range("A1").Select
    
End Sub
 
Upvote 0
L. Howard said:
Here is macro recorder version that seems to do what you want.

Copy the long list to cell C2, (I copied it from your post to cell C2).

Then run this code.

Howard

Code: 
Sub Macro3()
'
' Macro3 Macro
'
'
    Range("C3").Select
    ActiveCell.FormulaR1C1 = "=SUBSTITUTE(R[-1]C,"" "","""")"
    Range("C3").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.TextToColumns Destination:=Range("C3"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
        (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), _
        Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array( _
        33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), _
        Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array( _
        46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), _
        Array(53, 1), Array(54, 1)), TrailingMinusNumbers:=True
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    ActiveWindow.LargeScroll ToRight:=-2
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    ActiveWindow.SmallScroll Down:=45
    Application.CutCopyMode = False
    Selection.AutoFill Destination:=Range("B2:B1010"), Type:=xlFillDefault
   ' Range("B2:B1010").Select
   
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "2"
    Range("A2:A3").Select
    Selection.AutoFill Destination:=Range("A2:A1010")
  '  Range("A2:A1010").Select
    Range("A1").Select
    
End Sub
Click to expand...

Not sure I have understood. what do you mean with: "Copy the long list to cell C2, (I copied it from your post to cell C2)?"
What is the purpose to write the list in that cell? I could write in the correct position just recording the Macro.
Am I understanding well?
I would like something more automatic.
 
Upvote 0
Upvote 0
But as you've already created that sheet why not keep it as a master & then just copy the 1st 2 columns into a new sheet when needed?
 
Upvote 0
Giancar said:
Hi,

I would like a VBA code to:
1) Create a New sheet called "Ranking"
2) In this new sheet, I want to create a list.
In A1 I want to have "Ranking", B1 I want to have "Category, C1 I want to have "ID", D1 I want to have "Name"

From A2 till A1010 a list of numbers: A2 I want to have 1, A3 I want to have 2, A4 I want to have 3, etc.

From B2 till B54 I want the following list: DOM1, PKG, DOM1, INT, DOM1, EU, DOM1, PKG, DOM1, INT, DOM1, EU, DOM1, PKG, DOM1, INT, DOM1, EU, DOM2, PKG, DOM2, INT, DOM2, EU, DOM2, PKG, DOM2, INT, DOM2, EU, DOM2, PKG, DOM2, INT, DOM2, EU, DOM3, PKG, DOM3, INT, DOM3, EU, DOM3, PKG, DOM3, INT, DOM3, EU, DOM3, PKG, DOM3, INT, DOM3, EU.

B2:B54, then needs to be copy and pasted immediately below till row 1010.

Any help?


Any help?
Click to expand...
Your ranges are not correct (should be B2:B55 and B2:B1027 in total). Here is a macro that will fill those cells on a newly created Ranking sheet...
Code: 
[table="width: 500"]
[tr]
	[td]Sub CreateRankingSheet()
  Dim R As Long
  Sheets.Add After:=Sheets(Sheets.Count)
  ActiveSheet.Name = "Ranking"
  Range("A1:D1") = Array("Ranking", "Category", "ID", "Name")
  For R = 2 To 974 Step 54
    Cells(R, "B").Resize(54) = Application.Transpose(Array("DOM1", "PKG", "DOM1", "INT", "DOM1", "EU", "DOM1", "PKG", "DOM1", "INT", "DOM1", "EU", "DOM1", "PKG", "DOM1", "INT", "DOM1", "EU", "DOM2", "PKG", "DOM2", "INT", "DOM2", "EU", "DOM2", "PKG", "DOM2", "INT", "DOM2", "EU", "DOM2", "PKG", "DOM2", "INT", "DOM2", "EU", "DOM3", "PKG", "DOM3", "INT", "DOM3", "EU", "DOM3", "PKG", "DOM3", "INT", "DOM3", "EU", "DOM3", "PKG", "DOM3", "INT", "DOM3", "EU"))
  Next
End Sub[/td]
[/tr]
[/table]
 
Upvote 0
Rick Rothstein said:
Your ranges are not correct (should be B2:B55 and B2:B1027 in total). Here is a macro that will fill those cells on a newly created Ranking sheet...
Code: 
[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub CreateRankingSheet()
  Dim R As Long
  Sheets.Add After:=Sheets(Sheets.Count)
  ActiveSheet.Name = "Ranking"
  Range("A1:D1") = Array("Ranking", "Category", "ID", "Name")
  For R = 2 To 974 Step 54
    Cells(R, "B").Resize(54) = Application.Transpose(Array("DOM1", "PKG", "DOM1", "INT", "DOM1", "EU", "DOM1", "PKG", "DOM1", "INT", "DOM1", "EU", "DOM1", "PKG", "DOM1", "INT", "DOM1", "EU", "DOM2", "PKG", "DOM2", "INT", "DOM2", "EU", "DOM2", "PKG", "DOM2", "INT", "DOM2", "EU", "DOM2", "PKG", "DOM2", "INT", "DOM2", "EU", "DOM3", "PKG", "DOM3", "INT", "DOM3", "EU", "DOM3", "PKG", "DOM3", "INT", "DOM3", "EU", "DOM3", "PKG", "DOM3", "INT", "DOM3", "EU"))
  Next
End Sub[/TD]
[/TR]
</tbody>[/TABLE]
Click to expand...

Perfect! It works. Thank you Roth
 
Upvote 0
Fluff said:
But as you've already created that sheet why not keep it as a master & then just copy the 1st 2 columns into a new sheet when needed?
Click to expand...

Because I am not the only that will work on this doc, that is a Gdoc converted in Excel and I can not add that sheet (in the Gdoc version).
It will be easier to share the code.
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question
How To Allow Only One Checkbox to Be Checked in Excel per Table
Replies
1
Views
143
bobsan42
bobsan42
L
  • Question
export specific sheets based on sheets names list into column and same formatting
Replies
0
Views
286
leap out
L
B
  • Question
Prevent Line from Continuing Point-to-Point (Non-continuous) On Scatter Plot in VBA
Replies
1
Views
475
Jon Peltier
J
S
  • Question
Replace different text/strings in multiple files in one folder
Replies
1
Views
333
Peter_SSs
Peter_SSs
B
  • Solved
VBA Help - Same Function needed for multiple sheets
Replies
2
Views
270
birdman15
B

Forum statistics

Threads
1,215,616
Messages
6,125,865
Members
449,266
Latest member
davinroach

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