VBA - Create New Array from Old Array

[Dsewardj]

I have populated an array with the all the values in column TeamTF. I would like to populate a new array with just the text values and not the blank cells. I have no clue how to do this.

<TABLE style="WIDTH: 75pt; BORDER-COLLAPSE: collapse" cellSpacing=0 cellPadding=0 width=100 border=0 x:str><COLGROUP><COL style="WIDTH: 75pt; mso-width-source: userset; mso-width-alt: 3657" width=100><TBODY><TR style="HEIGHT: 25.5pt" height=34><TD class=xl67 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; WIDTH: 75pt; BORDER-BOTTOM: #d4d0c8; HEIGHT: 25.5pt; BACKGROUND-COLOR: yellow" width=100 height=34>TeamTF</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl69 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext 0.5pt solid; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: black" height=17></TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl68 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: #cc99ff" height=17 x:str=""></TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl68 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: #cc99ff" height=17 x:str=""></TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl68 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: #cc99ff" height=17>DP</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl68 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: #cc99ff" height=17 x:str=""></TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl68 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: #cc99ff" height=17>FI</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl68 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: #cc99ff" height=17 x:str=""></TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl68 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: #cc99ff" height=17>IT</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl68 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: #cc99ff" height=17 x:str=""></TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl68 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: #cc99ff" height=17>MFG</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl68 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: #cc99ff" height=17 x:str=""></TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl68 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: #cc99ff" height=17>OTC</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl68 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: #cc99ff" height=17 x:str=""></TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl68 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: #cc99ff" height=17>PTPDIR</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl68 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: #cc99ff" height=17 x:str=""></TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl68 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: #cc99ff" height=17 x:str=""></TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl68 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: #cc99ff" height=17>SCP</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl68 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: #cc99ff" height=17 x:str=""></TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl68 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: #cc99ff" height=17>Titan</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl68 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: #cc99ff" height=17 x:str=""></TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl69 style="BORDER-RIGHT: windowtext 0.5pt solid; BORDER-TOP: windowtext; BORDER-LEFT: windowtext 0.5pt solid; BORDER-BOTTOM: windowtext 0.5pt solid; HEIGHT: 12.75pt; BACKGROUND-COLOR: black" height=17></TD></TR></TBODY></TABLE>

I am assuming I can perform a loop with an IF statement to determine whether or not an element in the array actually holds a text value. I could then somehow count the number of elements that are text values and populate a new array with only them, but I have no clue how to do this. Could anyone point me to some resources or perhaps provide some code.

 

[iliace]

On Chip Pearson's web site, there is a collection of VBA array manipulation functions:

http://www.cpearson.com/excel/VBAArrays.htm

You could use MoveEmptyStringsToEndOfArray and then ReDim Preserve to the number of non-empty elements.

 

[Dsewardj]

Thanks for the link. I will check it out.

 

[MickG]

Hi, Here's some an option without Loops.

[COLOR="Navy"]Sub[/COLOR] MG10Dec41
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Ray
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
'[COLOR="Green"][B]Copy Old Range to New Range[/B][/COLOR]
Rng.Copy Range("F1")
'[COLOR="Green"][B]Delete all Blank cells in New Range[/B][/COLOR]
Range("F1").Resize(Rng.Count).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
'[COLOR="Green"][B]Place New Range in Array "Ray"[/B][/COLOR]
Ray = Range(Range("F1"), Range("F" & Rows.Count).End(xlUp))
'[COLOR="Green"][B]Delete Data in Column "F" (New Range)[/B][/COLOR]
Columns("F").Value = ""
'[COLOR="Green"][B]Place Array "Ray" Back on sheet[/B][/COLOR]
Range("G1").Resize(UBound(Ray)) = Ray
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Dsewardj]

This is what I ended up doing. I created two arrays. The first array, teamTfArray, was populated with 19 elements from the 19 cells in the TeamTf column. I then created another array called prntTeamArray, which I resized by determining how many cells in TeamTf contained text. I used a COUNTIF function and returned the sum of the results in a named range pfTeamCnt.

I then used a loop function which checked each element in teamTfArray; if the element was not equal to "" then I knew that it contained a text value, and assigned it to an element in prntTeamArray.

The code below simply outputs the results into a sheet named Metrics-Site. The whole point of this code is just to let the user know which teams he or she collected in a Metrics Report. Unfortunately I know of no other way to do this in Excel besides using VBA code.

'Determine teams selected and populate array
Dim teamTfArray() As Variant
Dim prntTeamArray() As String
Dim x, j, z
j = 0
z = Sheets("Valid Values").Range("pfTeamCnt").Value
ReDim prntTeamArray(1 To z)
teamTfArray() = Sheets("Valid Values").Range("TeamTF").Value
For Each x In teamTfArray()
    If x = "" Then
    Else
    j = 1 + j
    prntTeamArray(j) = x
    End If
Next x
'Print array in Metrics-Site worksheet
With Sheets("Metrics-Site").Range("J1")
    For i = 1 To z
        If i = z Then
            .Value = .Value + prntTeamArray(i)
        Else
            .Value = .Value + prntTeamArray(i) & ", "
        End If
    Next
End With