VBA - Skipping blank cells/0 to existing macro

[spared]

Hi all,

I appreciate everyone looking at this post seeing if they can help! This has been eluding me for some time because VBA is not my strong suit. It took some deep-diving to get what I have and adding in this condition has been unsuccessful.

I have a worksheet that I want to concatenate into another sheet - it is 6 columns starting from a fixed cell and copies any data over with a delimiter - code below. The sheet that it is pulling from has conditional formatting that hide 0s along with formulas and I would prefer if it did not include them and concatenate as if there was a blank instead. Is there an easier way to achieve what I am looking for?

Thank you in advance!!

Dim Rng As Range
Dim EntryWs As Worksheet
Dim EntryLastRow As Long, x As Long

Set EntryWs = ThisWorkbook.Worksheets("Entry")

EntryLastRow = EntryWs.Range("A" & Rows.Count).End(xlUp).Row

Set Rng = EntryWs.Range("F5:K" & EntryLastRow)

Dim Column_Numbers() As Variant
Column_Numbers = Array(1, 2, 3, 4, 5, 6)

Separator = "|"

Output_Worksheet = "Upload"
Output_Cell = "E11"

For i = 1 To Rng.Rows.Count
    Output = ""
    For j = LBound(Column_Numbers) To UBound(Column_Numbers)
        If j <> UBound(Column_Numbers) Then
            Output = Output & Rng.Cells(i, Int(Column_Numbers(j))) & Separator
        Else
            Output = Output & Rng.Cells(i, Int(Column_Numbers(j)))
        End If
    Next j
   Worksheets(Output_Worksheet).Range(Output_Cell).Cells(i, 1) = Output
Next i

End Sub

 

[HaHoBe]

Hi spared,

if you always want to overwrite existing data on the target sheet what about

Public Sub MrE_1227482_1701408()
' https://www.mrexcel.com/board/threads/vba-skipping-blank-cells-0-to-existing-macro.1227482/
Dim lngStart As Long
Dim rngCell As Range
Dim rngArea As Range
Dim rngWork As Range
Dim strTemp As String
Dim wsEntry As Worksheet
Dim wsTarget As Worksheet

Const cstrSep As String = "|"
Const cstrTargCol As String = "E"

Set wsTarget = ThisWorkbook.Worksheets("Upload")
Set wsEntry = ThisWorkbook.Worksheets("Entry")

With wsEntry
  Set rngWork = .Range("F5:K" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With

lngStart = 11

'delete contents on target sheet from E11 down
With wsTarget
  .Range(.Cells(lngStart, cstrTargCol), .Cells(.Range(cstrTargCol & .Rows.Count).End(xlUp).Row)).ClearContents
End With

For Each rngArea In rngWork.Rows
  strTemp = ""
  For Each rngCell In rngArea.Cells
      If rngCell.Value = 0 Or rngCell.HasFormula Then
        strTemp = strTemp & " " & cstrSep
      Else
        strTemp = strTemp & rngCell.Value & cstrSep
      End If
  Next rngCell
  wsTarget.Cells(lngStart, cstrTargCol) = Left(strTemp, Len(strTemp) - 1)
  lngStart = lngStart + 1
Next rngArea

Set rngWork = Nothing
Set wsTarget = Nothing
Set wsEntry = Nothing
End Sub

Ciao,
Holger