Array in VBA: For a specific row, gives me the values (corrresponding to the column) and skips the b-CodePudding

I'm currently stuck on a couple of issues in VBA. I have a data set with multiple rows and columns.

Example would be:

   A     B        C       D       E      F    ...
1 Name    Food 1   Food 2  Food 3  Food4  Food 5 ...
2 Ami  Oranges  Twix            Pizza  Grapes
3 Ben  Banana   Apples  Eggs           Coke
4 Mike Peaches                  Burger Coffee
5 Lea  Peas     Berries Cake    Chips  Sprite        
...

What I want to do is to have that data read through an array so it gives me the following back:

Name    Food 1   Food 2  Food 4  Food 5 ...
Ami     Oranges  Twix    Pizza   Grapes

The food of the corresponding name but without including the blank cells or column.

I did find a Youtube video that helped, only issue with the code in the video is that it creates for each row a new worksheet!! Which I do not want as, there is already a designated worksheet, within the workbook, it's supposed to appear in. Which will later be used as table in an outlook item.

The code I got from Youtube is the following:

 Dim CompInfo(0 To 170, 1 To 21)
 Dim r As Long, c As Long
 Const StartRow As Long = 1
 Dim ShNew As Worksheet
 
 For r = 0 To 170
 
     For c = 1 To 21
         CompInfo(r, c) = Cells(r   StartRow, c).Value
     Next c
 Next r
 
 For r = 0 To 170
     Set ShNew = Worksheets.Add
     ShNew.Name = CompInfo(r, 2)
    
 'Setting the headers
     ShNew.Range("A1").Value = CompInfo(0, 1)
     ShNew.Range("B1").Value = CompInfo(0, 2)
     ShNew.Range("C1").Value = CompInfo(0, 3)
     ShNew.Range("D1").Value = CompInfo(0, 4)
     ShNew.Range("E1").Value = CompInfo(0, 5)
     ShNew.Range("F1").Value = CompInfo(0, 6)
     ShNew.Range("G1").Value = CompInfo(0, 7)
     ShNew.Range("H1").Value = CompInfo(0, 8)
     ShNew.Range("I1").Value = CompInfo(0, 9)
     ShNew.Range("J1").Value = CompInfo(0, 10)
     ShNew.Range("K1").Value = CompInfo(0, 11)
     ShNew.Range("L1").Value = CompInfo(0, 12)
     ShNew.Range("M1").Value = CompInfo(0, 13)
     ShNew.Range("N1").Value = CompInfo(0, 14)
     ShNew.Range("O1").Value = CompInfo(0, 15)
     ShNew.Range("P1").Value = CompInfo(0, 16)
     ShNew.Range("Q1").Value = CompInfo(0, 17)
     ShNew.Range("R1").Value = CompInfo(0, 18)
     ShNew.Range("S1").Value = CompInfo(0, 19)
     ShNew.Range("T1").Value = CompInfo(0, 20)
     ShNew.Range("U1").Value = CompInfo(0, 21)
     

 'Setting the accounts

     ShNew.Range("A2").Value = CompInfo(r, 1)
     ShNew.Range("B2").Value = CompInfo(r, 2)
     ShNew.Range("C2").Value = CompInfo(r, 3)
     ShNew.Range("D2").Value = CompInfo(r, 4)
     ShNew.Range("E2").Value = CompInfo(r, 5)
     ShNew.Range("F2").Value = CompInfo(r, 6)
     ShNew.Range("G2").Value = CompInfo(r, 7)
     ShNew.Range("H2").Value = CompInfo(r, 8)
     ShNew.Range("I2").Value = CompInfo(r, 9)
     ShNew.Range("J2").Value = CompInfo(r, 10)
     ShNew.Range("K2").Value = CompInfo(r, 11)
     ShNew.Range("L2").Value = CompInfo(r, 12)
     ShNew.Range("M2").Value = CompInfo(r, 13)
     ShNew.Range("N2").Value = CompInfo(r, 14)
     ShNew.Range("O2").Value = CompInfo(r, 15)
     ShNew.Range("P2").Value = CompInfo(r, 16)
     ShNew.Range("Q2").Value = CompInfo(r, 17)
     ShNew.Range("R2").Value = CompInfo(r, 18)
     ShNew.Range("S2").Value = CompInfo(r, 19)
     ShNew.Range("T2").Value = CompInfo(r, 20)
     ShNew.Range("U2").Value = CompInfo(r, 21)

 Next r
 
End Sub

Now this code gives partially what I want but it would be could if I could have it without having a new worksheet created for every row. Not to mention that I also tried adding that it should not show/print those cells that are empty even if the cell above is filled.

 
 If Range("C1").Select <> "" And Range("C2").Select = "" Then
     Range("C1:C2").Offset(0, 1).Select
 End If

So with every thing what am I doing wrong? Would be great if someone could help me :)

Thanks you very much

CodePudding user response：

Export to Another Worksheet

Option Explicit

Sub ExportNamesAndFood()
    
    ' s - Source
    Const sName As String = "Sheet1"
    ' d - Destination
    Const dName As String = "Sheet2"
    Const dFirst As String = "A2"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code

    Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
    Dim srg As Range: Set srg = sws.Range("A1").CurrentRegion
    Dim srCount As Long: srCount = srg.Rows.Count
    If srCount < 2 Then Exit Sub ' no data or only headers
    Dim cCount As Long: cCount = srg.Columns.Count
    Dim drCount As Long: drCount = (srCount - 1) * 2
    
    Dim sData As Variant: sData = srg.Value
    Dim dData As Variant: ReDim dData(1 To drCount, 1 To cCount)
    
    Dim sr As Long
    Dim sc As Long
    Dim dr As Long
    Dim dc As Long
    
    For sr = 2 To srCount
        If Len(CStr(sData(sr, 1))) > 0 Then ' name found
            ' Name
            dr = dr   2
            dData(dr - 1, 1) = sData(1, 1)
            dData(dr, 1) = sData(sr, 1)
            ' Food
            dc = 1
            For sc = 2 To cCount
                If Not IsEmpty(sData(sr, sc)) Then ' food found
                    dc = dc   1
                    dData(dr - 1, dc) = sData(1, sc)
                    dData(dr, dc) = sData(sr, sc)
                'Else ' food not found
                End If
            Next sc
        'Else ' no name found
        End If
    Next sr
    
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
    Dim dCell As Range: Set dCell = dws.Range(dFirst)
    Dim drg As Range: Set drg = dCell.Resize(dr, cCount)
    
    drg.Value = dData
    
    MsgBox "Data exported.", vbInformation

End Sub