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

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
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

D
  • Solved
VBA to copy only matching data from 2 csv workbooks into the "MasterCSV"
2
Replies
18
Views
949
Peter_SSs
Peter_SSs
D
  • Locked
  • Question Question
VBA to copy only matching data from 2 csv workbooks into the "Master Workbook"
Replies
1
Views
338
RoryA
RoryA
T
  • Question Question
Cant convert to True numbers
Replies
1
Views
397
Alex Blakenburg
A
G
  • Solved
run VBA when clicked
Replies
4
Views
184
Gylle
G
M
  • Question Question
How To Allow Only One Checkbox to Be Checked in Excel per Table
Replies
1
Views
669
bobsan42
bobsan42

Forum statistics

Threads
1,224,822
Messages
6,181,164
Members
453,021
Latest member
Justyna P

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