title: Copy range of cells (excluding blanks) into one cell
body: <p>I am working on VBA macro that will check string in Tab &quot;Tracker&quot; in column &quot;S&quot; with list, if match is found it will skip that row and move to the next.
  If string in column &quot;S&quot; is not on the list, it will then copy Range(&quot;U3:Y3&quot;) to the right of that active &quot;S&quot; cell and paste it to the one cell in Tab &quot;Report&quot;.</p>
  <p><a href="https://i.stack.imgur.com/QGBpo.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/QGBpo.png" alt="enter image description here" /></a></p>
  <p>I manage to copy successfully the range, but it also contain cells that are blank therfore it give me unnecesary empty space in cell I am pasting to.</p>
  <pre><code>Sub ImportData()
  
      'Create array with Status type values
      Dim StatusList As Object
      Set StatusList = CreateObject(&quot;Scripting.Dictionary&quot;)
      
      StatusList.Add &quot;Cancelled&quot;, 1
      StatusList.Add &quot;Postponed&quot;, 2
      StatusList.Add &quot;Rescheduled&quot;, 3
      StatusList.Add &quot;Rolled Back&quot;, 4
      
      Dim StoresTotal As Long
      With Sheets(&quot;Tracker&quot;) 'Count cells containing values in row C
          StoresTotal = .Cells(Rows.count, &quot;C&quot;).End(xlUp).Row
          StoresTotal = StoresTotal - 2 'removing 2 for header values
          'MsgBox &quot;value is &quot; &amp; StoresTotal
      End With
      
      'Copy Status from the first cell
      Dim Status As String
      Sheets(&quot;Tracker&quot;).Select
      Range(&quot;S3&quot;).Activate
      Status = ActiveCell.Value
      'MsgBox &quot;value is &quot; &amp; Status
      
      Dim StatusLoopCounter As Integer
      StatusLoopCounter = 0
      
      Dim SiteNamePos As Integer
      SiteNamePos = 8
      
      Dim DevicesPos As Integer
      DevicesPos = 10
      
      Dim DevicesUYRange As String
          
      Do Until StatusLoopCounter = StoresTotal 'open Status column check loop
          If StatusList.Exists(Status) Then
              'IF exists in the list then skip to next row
              MsgBox &quot;value is &quot; &amp; Status
              
              'lower position and increase the counter
              Selection.Offset(1, 0).Select
              Status = ActiveCell.Value
              StatusLoopCounter = StatusLoopCounter + 1
          Else
              'IF does not exist in the list
              Worksheets(&quot;Reports&quot;).Range(&quot;A&quot; &amp; SiteNamePos).Value = Worksheets(&quot;Tracker&quot;).Range(&quot;C&quot; &amp; (ActiveCell.Row)).Value
              
              DevicesUYRange = Join(Application.Transpose(Application.Transpose(Range(&quot;U3:Y3&quot;).Value)), vbCrLf)
              Worksheets(&quot;Reports&quot;).Range(&quot;A&quot; &amp; DevicesPos).Value = DevicesUYRange
              MsgBox DevicesUYRange
              
              'lower position and increase the counter
              Range(&quot;S&quot; &amp; (ActiveCell.Row)).Select
              Selection.Offset(1, 0).Select
              Status = ActiveCell.Value
              StatusLoopCounter = StatusLoopCounter + 1
          End If
  
      Loop 'close Status column check loop
  End Sub
  </code></pre>
  <p>I want to copy a range of cells excluding blanks and paste all the data into one cell in the following format.</p>
  <p><a href="https://i.stack.imgur.com/g6Mah.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/g6Mah.png" alt="enter image description here" /></a></p>
  <p>I have a feeling I am doing it completely wrong, please help me get rid of the blank cells from range selection. Thanks.</p>
  <p><strong>&lt;&lt;&lt;&lt;&lt; EDIT &gt;&gt;&gt;&gt;&gt;</strong> Added below extended description and full code</p>
  <p>Maybe if I describe the whole picture you will be able to help me get it sorted, possibly improving the code performance as well.</p>
  <p><strong>Tracker tab</strong>.<br />
  I update the Tracker tab during a week and check the status of project deliverables.
  Every Friday I have to send out a report that contain statuses of successfully executed deliverables only.</p>
  <p>I track count of total deliverables scheduled for the following week in cell (A1)
  I track successfully completed deliverables in cell B1. Basically excluding from total count the ones with status “postponed, cancelled, rescheduled” etc.</p>
  <p><a href="https://i.stack.imgur.com/xJXzg.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/xJXzg.png" alt="enter image description here" /></a></p>
  <p><strong>Reports tab:</strong>.<br />
  In this tab I will create a weekly report including header containing some overview generic data.
  After header section I will generate cells “blocks” for the number of successful deliverables. In my example case that will be x10 times.</p>
  <p>I wrote a macro to create and format the table, now I am looking for an efficient way to populate it.
  I have 3 operational buttons:</p>
  <ol>
  <li>Create Table – to create empty report template for the number of completed deliverables - Sub Report_Table()</li>
  <li>Clear Tab – to wipe all the cells in Reports tab - Sub ClearReport()</li>
  <li>Import Data – to populate the report with data from “Tracker” tab - Sub ImportData()</li>
  </ol>
  <p><a href="https://i.stack.imgur.com/RnuYc.gif" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/RnuYc.gif" alt="enter image description here" /></a></p>
  <p>Importing Data:
  When I click “Import Data” button in Reports tab, the macro will then:</p>
  <ol>
  <li>Go to Tracker tab and check the value of first cell in column S, that is S3. IF the cell value is different than (Cancelled, Postponed, Rescheduled, Rolled Back) it will copy data to the first block of the report
  <a href="https://i.stack.imgur.com/ZxOoV.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/ZxOoV.png" alt="enter image description here" /></a></li>
  <li>It will copy data from Tracker tab cell C3 (Site ID) and paste to Reports tab cell A15 (Site Name) <a href="https://i.stack.imgur.com/XdXDE.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/XdXDE.png" alt="enter image description here" /></a></li>
  <li>Copy Device names from range U3:Y3 excluding blank cells
  <a href="https://i.stack.imgur.com/uOmHr.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/uOmHr.png" alt="enter image description here" /></a></li>
  <li>and paste to a single cell in Reports tab cell in the following format
  <a href="https://i.stack.imgur.com/1LS5C.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/1LS5C.png" alt="enter image description here" /></a></li>
  <li>Check if the cell R at the same row contains value, IF yes
  <a href="https://i.stack.imgur.com/o5e35.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/o5e35.png" alt="enter image description here" /></a></li>
  <li>Copy comment from Tracker tab R to Reports tab Open Items
  <a href="https://i.stack.imgur.com/hSSho.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/hSSho.png" alt="enter image description here" /></a></li>
  <li>Then move one position down in S column and to the same for the number of cells in column S.</li>
  </ol>
  <p>There is a need to create an extra counter to move down position for pasting data when, If we pasted to 4th report block in that row row, It should then move down and continue pasting data.</p>
  <p>I struggle a bit with implementation of your solution, as I don’t understand your code fully.</p>
  <p>I have a few questions to my code below:</p>
  <p><strong>Q1.</strong> Is the way I copy specific cells efficient ? I have a feeling there is a simpler way to do it for cells at the same row.</p>
  <p><strong>Q2.</strong> Is my approach good, to create an empty report template first and later populate it with data? or should I look for a way to combine both actions for performance and speed ?</p>
  <p><strong>@user1274820</strong> Please help me to implement your solution into my code.
  Also all the comments/hints for my code are more than welcome, as I am still learning.</p>
  <p>Thank you.</p>
  <p><strong>General view of Tracker tab:</strong>
  <a href="https://i.stack.imgur.com/7zVK9.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/7zVK9.png" alt="enter image description here" /></a></p>
  <p><strong>Generate table template (Create Table button):</strong></p>
  <pre><code>Sub Report_Table()
  
      Dim StartTime As Double
      Dim SecondsElapsed As Double
  
      StartTime = Timer
      
      'Create report header table
      Range(&quot;A2:D5&quot;).Select
      
      Selection.Borders(xlDiagonalDown).LineStyle = xlNone
      Selection.Borders(xlDiagonalUp).LineStyle = xlNone
      With Selection.Borders(xlEdgeLeft)
          .LineStyle = xlContinuous
          .ColorIndex = xlAutomatic
          .TintAndShade = 0
          .Weight = xlMedium
      End With
      With Selection.Borders(xlEdgeTop)
          .LineStyle = xlContinuous
          .ColorIndex = xlAutomatic
          .TintAndShade = 0
          .Weight = xlMedium
      End With
      With Selection.Borders(xlEdgeBottom)
          .LineStyle = xlContinuous
          .ColorIndex = xlAutomatic
          .TintAndShade = 0
          .Weight = xlMedium
      End With
      With Selection.Borders(xlEdgeRight)
          .LineStyle = xlContinuous
          .ColorIndex = xlAutomatic
          .TintAndShade = 0
          .Weight = xlMedium
      End With
      With Selection.Borders(xlInsideVertical)
          .LineStyle = xlContinuous
          .ColorIndex = xlAutomatic
          .TintAndShade = 0
          .Weight = xlMedium
      End With
      With Selection.Borders(xlInsideHorizontal)
          .LineStyle = xlContinuous
          .ColorIndex = xlAutomatic
          .TintAndShade = 0
          .Weight = xlMedium
      End With
      With Selection
          .HorizontalAlignment = xlGeneral
          .VerticalAlignment = xlCenter
          .WrapText = False
          .Orientation = 0
          .AddIndent = False
          .IndentLevel = 0
          .ShrinkToFit = False
          .ReadingOrder = xlContext
          .MergeCells = False
      End With
      With Selection
          .HorizontalAlignment = xlLeft
          .VerticalAlignment = xlCenter
          .WrapText = False
          .Orientation = 0
          .AddIndent = False
          .IndentLevel = 0
          .ShrinkToFit = False
          .ReadingOrder = xlContext
          .MergeCells = False
      End With
      Range(&quot;A2:D2,A4:D4&quot;).Select
      Range(&quot;A4&quot;).Activate
      Selection.Font.Bold = True
      With Selection.Interior
          .Pattern = xlSolid
          .PatternColorIndex = xlAutomatic
          .ThemeColor = xlThemeColorAccent1
          .TintAndShade = 0.599993896298105
          .PatternTintAndShade = 0
      End With
      
      'Populate header table
      [A2].Value = &quot;Partner:&quot;
      [A3].Value = &quot;Partner name here&quot;
      [A4].Value = &quot;Number of Sites:&quot;
      Sheets(&quot;Tracker&quot;).Range(&quot;B1&quot;).Copy
      Sheets(&quot;Reports&quot;).Range(&quot;A5&quot;).PasteSpecial xlPasteValues
      
      [B2].Value = &quot;Scope:&quot;
      [B3].Value = &quot;FFF &amp; TTP&quot;
      [B4].Value = &quot;Pods:&quot;
      [B5].Value = &quot;n/a&quot;
      
      [C2].Value = &quot;Sponsor:&quot;
      [C3].Value = &quot;Input sponsor name&quot;
      [C4].Value = &quot;Number of Devices:&quot;
      Sheets(&quot;Tracker&quot;).Range(&quot;T1&quot;).Copy
      Sheets(&quot;Reports&quot;).Range(&quot;C5&quot;).PasteSpecial xlPasteValues
      
      [D2].Value = &quot;Engineer:&quot;
      [D3].Value = &quot;n/a&quot;
      [D4].Value = &quot;PM:&quot;
      [D5].Value = &quot;PM name here&quot;
      
      'Create Report device table template blocks
      Range(&quot;A7:A12&quot;).Select
      Selection.Borders(xlDiagonalDown).LineStyle = xlNone
      Selection.Borders(xlDiagonalUp).LineStyle = xlNone
      With Selection.Borders(xlEdgeLeft)
          .LineStyle = xlContinuous
          .ColorIndex = xlAutomatic
          .TintAndShade = 0
          .Weight = xlMedium
      End With
      With Selection.Borders(xlEdgeTop)
          .LineStyle = xlContinuous
          .ColorIndex = xlAutomatic
          .TintAndShade = 0
          .Weight = xlMedium
      End With
      With Selection.Borders(xlEdgeBottom)
          .LineStyle = xlContinuous
          .ColorIndex = xlAutomatic
          .TintAndShade = 0
          .Weight = xlMedium
      End With
      With Selection.Borders(xlEdgeRight)
          .LineStyle = xlContinuous
          .ColorIndex = xlAutomatic
          .TintAndShade = 0
          .Weight = xlMedium
      End With
      Selection.Borders(xlInsideVertical).LineStyle = xlNone
      With Selection.Borders(xlInsideHorizontal)
          .LineStyle = xlContinuous
          .ColorIndex = xlAutomatic
          .TintAndShade = 0
          .Weight = xlMedium
      End With
      With Selection
          .HorizontalAlignment = xlGeneral
          .VerticalAlignment = xlCenter
          .WrapText = False
          .Orientation = 0
          .AddIndent = False
          .IndentLevel = 0
          .ShrinkToFit = False
          .ReadingOrder = xlContext
          .MergeCells = False
      End With
      With Selection
          .HorizontalAlignment = xlLeft
          .VerticalAlignment = xlCenter
          .WrapText = False
          .Orientation = 0
          .AddIndent = False
          .IndentLevel = 0
          .ShrinkToFit = False
          .ReadingOrder = xlContext
          .MergeCells = False
      End With
      Range(&quot;A7,A9,A11&quot;).Select
      Range(&quot;A11&quot;).Activate
      Selection.Font.Bold = True
      With Selection.Interior
          .Pattern = xlSolid
          .PatternColorIndex = xlAutomatic
          .ThemeColor = xlThemeColorAccent1
          .TintAndShade = 0.599993896298105
          .PatternTintAndShade = 0
      End With
      
      [A7].Value = &quot;Site Name:&quot;
      [A9].Value = &quot;Devices:&quot;
      [A11].Value = &quot;Open Items:&quot;
      
      Range(&quot;A8,A10,A12&quot;).Select
      Range(&quot;A12&quot;).Activate
      With Selection
          .HorizontalAlignment = xlLeft
          .VerticalAlignment = xlCenter
          .WrapText = True
          .Orientation = 0
          .AddIndent = False
          .IndentLevel = 0
          .ShrinkToFit = False
          .ReadingOrder = xlContext
          .MergeCells = False
      End With
      
      'Assign Total number of deliverables Tracker-A1
      Dim MigrationTotal As Integer
      MigrationTotal = Sheets(&quot;Tracker&quot;).Range(&quot;B1&quot;).Value
      
      Range(&quot;A7:A12&quot;).Select
      Selection.Copy
      'MsgBox Selection.Column
      'MsgBox &quot;value is &quot; &amp; MigrationTotal
      
      Dim LoopCounter As Integer
      LoopCounter = 1
      
      Do Until LoopCounter = MigrationTotal 'open column loop
          If Selection.Column &gt;= 4 Then 'move one line below
          'MsgBox Selection.Column
          Selection.Offset(0, 1).Select
          Selection.Offset(7, -4).Select
          ActiveSheet.Paste
          LoopCounter = LoopCounter + 1
          Else
          Selection.Offset(0, 1).Select
          ActiveSheet.Paste
          LoopCounter = LoopCounter + 1
          End If
      Loop 'close column loop
      Application.CutCopyMode = False
      
      'MsgBox &quot;value is &quot; &amp; MigrationTotal
      
      SecondsElapsed = Round(Timer - StartTime, 2)
      MsgBox &quot;Report table completed in: &quot; &amp; SecondsElapsed &amp; &quot; seconds&quot;, vbInformation
      
  End Sub
  </code></pre>
  <p><strong>Clear button:</strong></p>
  <pre><code>Sub ClearReport()
  
      Range(&quot;A1:H40&quot;).Clear
  
  End Sub
  </code></pre>
  <p><strong>Import Data button:</strong></p>
  <pre><code>Sub ImportData()
  
      'Create array with Status type values
      Dim StatusList As Object
      Set StatusList = CreateObject(&quot;Scripting.Dictionary&quot;)
      
      StatusList.Add &quot;Cancelled&quot;, 1
      StatusList.Add &quot;Postponed&quot;, 2
      StatusList.Add &quot;Rescheduled&quot;, 3
      StatusList.Add &quot;Rolled Back&quot;, 4
      
      Dim StoresTotal As Long
      With Sheets(&quot;Tracker&quot;) 'Count cells containing values in row C
          StoresTotal = .Cells(Rows.count, &quot;C&quot;).End(xlUp).Row
          StoresTotal = StoresTotal - 2 'removing 2 for header values
          'MsgBox &quot;value is &quot; &amp; StoresTotal
      End With
      
      'Copy Status from the first cell
      Dim Status As String
      Sheets(&quot;Tracker&quot;).Select
      Range(&quot;S3&quot;).Activate
      Status = ActiveCell.Value
      'MsgBox &quot;value is &quot; &amp; Status
      
      Dim StatusLoopCounter As Integer
      StatusLoopCounter = 0
      
      Dim SiteNamePos As Integer
      SiteNamePos = 8
      
      Dim DevicesPos As Integer
      DevicesPos = 10
      
      Dim DevicesUYRange As String
          
      Do Until StatusLoopCounter = StoresTotal 'open Status column check loop
          If StatusList.Exists(Status) Then
              'IF exists in the list then skip to next row
              MsgBox &quot;value is &quot; &amp; Status
              
              'lower position and increase the counter
              Selection.Offset(1, 0).Select
              Status = ActiveCell.Value
              StatusLoopCounter = StatusLoopCounter + 1
          Else
              'IF does not exist in the list
              Worksheets(&quot;Reports&quot;).Range(&quot;A&quot; &amp; SiteNamePos).Value = Worksheets(&quot;Tracker&quot;).Range(&quot;C&quot; &amp; (ActiveCell.Row)).Value
              
              DevicesUYRange = Join(Application.Transpose(Application.Transpose(Range(&quot;U3:Y3&quot;).Value)), vbCrLf)
              Worksheets(&quot;Reports&quot;).Range(&quot;A&quot; &amp; DevicesPos).Value = DevicesUYRange
              MsgBox DevicesUYRange
              
              'lower position and increase the counter
              Range(&quot;S&quot; &amp; (ActiveCell.Row)).Select
              Selection.Offset(1, 0).Select
              Status = ActiveCell.Value
              StatusLoopCounter = StatusLoopCounter + 1
          End If
  
      Loop 'close Status column check loop
  
  End Sub
  </code></pre>
  <p>NOTE: I know my screenshots are blown away, not sure why, probably because of Laptop resolution is 4k... I will reupload when I'm back home.</p>