-1

Is there any possible way to take a list of items or names, such as:

Apples
Oranges
Grapes
Watermelons

And have Excel double that information and sequentially number it, like this:

Apples1
Apples2
Oranges1
Oranges2
Grapes1
Grapes2
Watermelons1
Watermelons2

I know a little bit of VBA but I can't wrap my head around how I would even start this.

GSerg
  • 76,472
  • 17
  • 159
  • 346
  • it will be `="Apples" + if(countif(a1:a100,"Apples")<=1,"",countif(a1:a100,"Apples"))` – Nathan_Sav Jan 04 '19 at 14:57
  • 1
    Possible duplicate of [Is there a way to perform a cross join or Cartesian product in excel?](https://stackoverflow.com/q/26999604/11683) – GSerg Jan 04 '19 at 14:58

3 Answers3

3

You can specify where you want to read, and where you want to start write and how many times you want to repeat! Just change the code:

Sub DoRepeat()
Dim repeatTimes As Integer
Dim rng As Range, cell As Range

repeatTimes = 2

Set cellsToRead = Range("A1:A3")
Set cellStartToWrite = Range("B1")

For Each cell In cellsToRead
    For i = 1 To repeatTimes
        cellStartToWrite.Value = cell.Value + CStr(i)
        Set cellStartToWrite = Cells(cellStartToWrite.Row + 1, cellStartToWrite.Column)
    Next
Next cell

End Sub
Jorge Ribeiro
  • 1,128
  • 7
  • 17
2

As it seems it is required to have a more dynamic approach, try this out. The DoubleNames function will return the names duplicated N number of times specified in the DuplicateCount parameter. It will return a Collection, which you can easily dump to a range if need be.

Public Function DoubleNames(ByVal DataRange As Excel.Range, DuplicateCount As Long) As Collection
    Set DoubleNames = New Collection
    Dim dict     As Object: Set dict = CreateObject("Scripting.Dictionary")
    Dim i        As Long
    Dim DataItem As Excel.Range
    Set DataRange = DataRange.SpecialCells(xlCellTypeConstants)

    For Each DataItem In DataRange
        For i = 1 To DuplicateCount
            If Not dict.Exists(DataItem.Value) Then
                DoubleNames.Add (DataItem.Value & "1")
                dict.Add DataItem.Value, 1
            Else
                dict(DataItem.Value) = dict(DataItem.Value) + 1
                DoubleNames.Add (DataItem.Value & dict(DataItem.Value))
            End If
        Next
    Next
End Function

Sub ExampleUsage()
    Dim item As Variant
    Dim rng As Range: Set rng = ThisWorkbook.Sheets("Sheet1").Range("A1:A5")
    For Each item In DoubleNames(rng, 5)
        Debug.Print item
    Next
End Sub
Ryan Wildry
  • 5,612
  • 1
  • 15
  • 35
  • 1
    If you used a dictionary instead of collection then the output wouldn't require a loop, you could do `range("a1").resize(dicValues.count-1,1).value=dicValues.items()` – Nathan_Sav Jan 04 '19 at 15:12
  • We have about 75 thousand items. we will be doing this process to about 100 items a time. All of the Items name start with YN but after that it varies. So we will have around 100-150 items with names beginning with YN. – Austin Roberts Jan 04 '19 at 15:17
  • @RyanWildry I do have an excel file of all the items in our inventory. Would that help? – Austin Roberts Jan 04 '19 at 15:19
0

I would start by writing a general function that outputs the names (passed as a variant array) a given number of times:

Public Sub OutputNames(ByVal TimesToOutput As Integer, ByRef names() As Variant)
    Dim nameIndex As Integer, outputIndex As Integer

    For nameIndex = LBound(names) To UBound(names)
        For outputIndex = 1 To TimesToOutput
            Debug.Print names(nameIndex) & outputIndex
        Next outputIndex
    Next nameIndex

End Sub

Here you can see the sub that tests this:

Public Sub testOutputNames()
    Dim names() As Variant
    names = Array("Apples", "Oranges", "Grapes", "Watermelons")
    OutputNames 2, names
End Sub

which gives you this output:

Apples1
Apples2
Oranges1
Oranges2
Grapes1
Grapes2
Watermelons1
Watermelons2
Zack
  • 2,220
  • 1
  • 8
  • 12