Don't copy blank cells or delete blank lines?

[PsycholoJackal]

Hi all,

For my project, I want to be able to have excel in VBA deliver usernames to 2 existing notepads that's in a folder. I made it so that it takes up to 10 usernames. My issue here is that sometimes I only need to deliver 1 username but in the text file it also delivers the empty cells which becomes the empty lines in the notepad. Any way to make it to not copy the blank cells or have it delete the blank lines? Code:

Option Explicit

Public Sub XLRangeToNotepad()

Dim iPtr As Integer
Dim sFileName As String
Dim intFH As Integer
Dim oCell As Range

sFileName = "C:\Users\" & Environ("UserName") & "\Desktop\TEST LOGOFF\Iron\logoff-users.txt"

Close
intFH = FreeFile()
Open sFileName For Append As intFH

For Each oCell In Range("B2:B11")
Print #intFH, oCell.Value
Next oCell

Close intFH

sFileName = "C:\Users\" & Environ("UserName") & "\Desktop\TEST CLEAN\Iron\clear-users.txt"

Close
intFH = FreeFile()
Open sFileName For Append As intFH

For Each oCell In Range("B2:B11")
Print #intFH, oCell.Value
Next oCell

Close intFH
MsgBox "Done!"

End Sub

 

[jmacleary]

I have added an if to your Print lines:

Option Explicit

Public Sub XLRangeToNotepad()

Dim iPtr As Integer
Dim sFileName As String
Dim intFH As Integer
Dim oCell As Range

sFileName = "C:\Users\" & Environ("UserName") & "\Desktop\TEST LOGOFF\Iron\logoff-users.txt"

Close
intFH = FreeFile()
Open sFileName For Append As intFH

For Each oCell In Range("B2:B11")
If Len(oCell.Value) > 0 Then Print #intFH, oCell.Value
Next oCell

Close intFH

sFileName = "C:\Users\" & Environ("UserName") & "\Desktop\TEST CLEAN\Iron\clear-users.txt"

Close
intFH = FreeFile()
Open sFileName For Append As intFH

For Each oCell In Range("B2:B11")
If Len(oCell.Value) > 0 Then Print #intFH, oCell.Value
Next oCell

Close intFH
MsgBox "Done!"

End Sub

 

[PsycholoJackal]

I have added an if to your Print lines:

Option Explicit

Public Sub XLRangeToNotepad()

Dim iPtr As Integer
Dim sFileName As String
Dim intFH As Integer
Dim oCell As Range

sFileName = "C:\Users\" & Environ("UserName") & "\Desktop\TEST LOGOFF\Iron\logoff-users.txt"

Close
intFH = FreeFile()
Open sFileName For Append As intFH

For Each oCell In Range("B2:B11")
If Len(oCell.Value) > 0 Then Print #intFH, oCell.Value
Next oCell

Close intFH

sFileName = "C:\Users\" & Environ("UserName") & "\Desktop\TEST CLEAN\Iron\clear-users.txt"

Close
intFH = FreeFile()
Open sFileName For Append As intFH

For Each oCell In Range("B2:B11")
If Len(oCell.Value) > 0 Then Print #intFH, oCell.Value
Next oCell

Close intFH
MsgBox "Done!"

End Sub

Hi John. I just tried it, it duplicated the usernames and also kept the bank lines in the notepad.

 

[jmacleary]

Oh dear - I'm not sure why that should happen (maybe the 'blank' cells have spaces in them?? - even so the code can't duplicate the rows as it steps through!), but try replacing the 2 if statements with this one:
If Len(oCell.Text) > 0 Then Print #intFH, oCell.Value
If there are spaces or other non-printable characters in the cells then we need to think again.

 

[NdNoviceHlp]

Maybe ...

If ocell.value <> vbnullstring then

HTH. Dave

 

[PsycholoJackal]

Oh dear - I'm not sure why that should happen (maybe the 'blank' cells have spaces in them?? - even so the code can't duplicate the rows as it steps through!), but try replacing the 2 if statements with this one:
If Len(oCell.Text) > 0 Then Print #intFH, oCell.Value
If there are spaces or other non-printable characters in the cells then we need to think again.

It works perfectly! Thank you so much for your help =)