converting rows of numbers to one column

[dwrowe001]

Hi everyone,

I would like to take strings of numbers from one sheet arranged in Rows and put them all into one column on another sheet. Eliminating any duplicates, zeros and no numbers above 60.
So I have numbers arranged as follows:
D12:R12,
D14:R14
D16:R16
D18:R18
D20:R20
D32:M32
D33:K33
D34:I34
In the above strings of numbers there could be for example in D12:R12, only 3 numbers in D12, E12, F12, and then Zeros in the rest of the cells to R12. For example, the numbers could be 03, 15, 45. numbers could range from 01 up to 99. and there could zeros as "00"

For example, In the row D14:R14, there could be numbers all the way to Q14 and 00 in R14.

Also, in the above strings there could be duplicate numbers either in the same string or in one or two of the other rows.

I would like to take all the above numbers from the rows and put them all in one continuous column on another sheet, eliminating any duplicates and zeros and numbers above 60…

So, for the first row D12:R12, the 3 numbers listed in the above example would be the first three numbers in the column the other sheet, all dups and zeros and numbers above 60removed. Then right under those three numbers would be the numbers from D14:R14…. And so on.

Thank you
Dave

 

[Peter_SSs]

A few clarifications:
1. You are looking for a macro, not a formula?
2. Regarding "00", is that (and all the other numbers in the ranges) a text string "00" or does the cell contain the number 0 and formatted with a custom format to show the 2 zeros?

 

[Rick Rothstein]

Assuming you want a macro, the following code should do what you want whether your cells are numbers or text). Note, I did not know the name of the sheet your data was on (I assumed Sheet1) nor the sheet you wanted output to go to (I assumed Sheet2 starting at cell A1)... change as needed.

[table="width: 500"]
[tr]
	[td]Sub RowsOfNumbersToSingleColumn()
  Dim Ar As Range, Joined As String, Nums() As String
  For Each Ar In Sheets("[B][COLOR="#FF0000"]Sheet1[/COLOR][/B]").Range("D12:R12,D14:R14,D16:R16,D18:R18,D20:R20,D32:M32,D33:K33,D34:I34").Areas
    Joined = Joined & " " & Join(Application.Index(Evaluate(Replace("IF(@="""","" "",TEXT(@,""00""))", "@", "'" & Ar.Parent.Name & "'!" & Ar.Address)), 1, 0))
  Next
  Nums = Split(Application.Trim(Joined))
  With Sheets("[B][COLOR="#FF0000"]Sheet2[/COLOR][/B]").Range("[B][COLOR="#FF0000"]A1[/COLOR][/B]").Resize(UBound(Nums) + 1)
    .NumberFormat = "@"
    .Value = Application.Transpose(Nums)
  End With
End Sub[/td]
[/tr]
[/table]

 

[Peter_SSs]

I have a different reading of the specifications (Rick I think you missed a few ).
Also, in lieu of no answer to my question 2, I have assumed that all of the cells in the original ranges are formatted the same (Text or custom number "00") and this code should replicate the same formatting in the destination sheet so that if the original values are numerical, they stay that way in the results.
I have assume the data sheet is the active sheet when the code is run.
I wasn't sure about the destination sheet either. My codes adds a new sheet for the results.

Sub CombineAndEliminate()
  Dim d As Object
  Dim c As Range
  Dim NumFormat As String
  
  Set d = CreateObject("Scripting.Dictionary")
  NumFormat = Range("D12").NumberFormat
  For Each c In Range("D12:R12,D14:R14,D16:R16,D18:R18,D20:R20,D32:M32,D33:K33,D34:I34")
      If Val(c.Text) <> 0 And Val(c.Text) <= 60 Then d(c.Text) = 1
  Next c
  Sheets.Add After:=ActiveSheet
  With Range("A1").Resize(d.Count)
    .NumberFormat = NumFormat
    .Value = Application.Transpose(d.keys)
  End With
End Sub

 

[Rick Rothstein]

I have a different reading of the specifications (Rick I think you missed a few ).

Read the whole question Rick!

Here is how my code would be modified to do everything the OP asked for. Note that I force the output to two-digit with leading zero text no matter what the source was.

[table="width: 500"]
[tr]
	[td]Sub RowsOfNumbersToSingleColumn()
  Dim X As Long, Ar As Range, Nums As Variant
  For Each Ar In Sheets("Sheet1").Range("D12:R12,D14:R14,D16:R16,D18:R18,D20:R20,D32:M32,D33:K33,D34:I34").Areas
    Nums = Nums & " " & Join(Application.Index(Evaluate(Replace("IF(@="""","" "",IF((0+@<=0)+(0+@>60),"" "",TEXT(@,""'00"")))", "@", "'" & Ar.Parent.Name & "'!" & Ar.Address)), 1, 0))
  Next
  Nums = Split(Application.Trim(Nums))
  With CreateObject("Scripting.Dictionary")
    For X = 0 To UBound(Nums)
      .Item(Nums(X)) = 1
    Next
    Sheets("Sheet2").Range("A1").Resize(.Count).Value = Application.Transpose(.Keys)
  End With
End Sub[/td]
[/tr]
[/table]

 

[Rick Rothstein]

Sub CombineAndEliminate()
  Dim d As Object
  Dim c As Range
  Dim NumFormat As String
  
  Set d = CreateObject("Scripting.Dictionary")
  NumFormat = Range("D12").NumberFormat
  For Each c In Range("D12:R12,D14:R14,D16:R16,D18:R18,D20:R20,D32:M32,D33:K33,D34:I34")
      If Val(c.Text) <> 0 And Val(c.Text) <= 60 Then d(c.Text) = 1
  Next c
  Sheets.Add After:=ActiveSheet
  With Range("A1").Resize(d.Count)
    .NumberFormat = NumFormat
    .Value = Application.Transpose(d.keys)
  End With
End Sub

Your code is fast (0.015 seconds on average on my computer if every cell has a value), but this new code I developed registers at 0 seconds (almost every time I run it) if every cell is filled.

[table="width: 500"]
[tr]
	[td]Sub RowsOfNumbersToSingleColumn()
  Dim Cell As Range, Joined() As String, Nums(1 To 60) As String
  For Each Cell In Sheets("Sheet1").Range("D12:R12,D14:R14,D16:R16,D18:R18,D20:R20,D32:M32,D33:K33,D34:I34")
    If CLng(Cell.Value) > 0 And CLng(Cell.Value) <= 60 And Len(Cell.Value) > 0 Then Nums(CLng(Cell.Value)) = Format$(Cell.Value, "00")
  Next
  Joined = Split(Application.Trim(Join(Nums)))
  With Sheets("Sheet2").Range("A1").Resize(UBound(Joined) + 1)
    .NumberFormat = "@"
    .Value = Application.Transpose(Joined)
  End With
End Sub[/td]
[/tr]
[/table]

 

[Peter_SSs]

Your code is fast (0.015 seconds on average on my computer if every cell has a value), but this new code I developed registers at 0 seconds (almost every time I run it) if every cell is filled.

I considered whether speed might be an issue but decided with only 99 cells in the whole range, it wasn't. So I didn't see any need bother. Who's going to notice?
I thought keeping the code as simple as possible to understand/maintain may be more relevant here.

 

[Rick Rothstein]

I considered whether speed might be an issue but decided with only 99 cells in the whole range, it wasn't. So I didn't see any need bother. Who's going to notice?
I thought keeping the code as simple as possible to understand/maintain may be more relevant here.

I did not develop my last macro with an eye to its speed. Actually, I have assumed for some time now that using a dictionary was probably the fastest method to develop a list of uniques values, so I was quite surprised at the speed it displayed. As for keeping the code simple, I am not so sure my code wouldn't be considered simple. The basic idea is to assign each number in the range, formatted to two digits (using leading zeroes for single digit numbers) to its index number in a String array. That's basically it. Duplicate numbers would simply overwrite the same number with itself at that number's index position, so only one of every number would end up in the array. Next, I use the Join function to put the elements of the array into a space delimited text string, use Excel's TRIM function to collapse multiple spaces to single spaces and then use the Split function to produce an array of unique, formatted numbers. Finally, I create a range of the proper size (using the Ubound from the array of unique values) and assign the transpose of the array to it. It took a lot of words to say it, but the underlying concept is (should be) easy enough to grasp.

 

[Peter_SSs]

I did not develop my last macro with an eye to its speed.

I only mentioned it because you raised the issue.

.. the underlying concept is (should be) easy enough to grasp.

I grasp it. Of course the OP can choose to do whatever they like.

 

[Rick Rothstein]

I only mentioned it because you raised the issue.

And I only raised it because of how surprised I was at its speed.

I grasp it. Of course the OP can choose to do whatever they like.

I know you grasped it... I'm pretty sure on first reading... that explanation was more for current and future readers of this thread than for you, it's just your comment gave me the opening to explain it.

Of course the OP can choose to do whatever they like.

Yes, of course, as is always the case.