Solved: Selection Rows CountA?

[mfleming]

Hello.

I'm trying to export a sheet to a text file.
My problem is my selection includes cell that do not have any values (they have formatting, Data Validation but no actual values).
So instead of stop at A6, it continues on until A2000 (the end of my formatting, data validation ect)
I'm using the following:

[vba]
Dim iNumRows As Integer
iNumRows = Selection.Rows.Count
[/vba]
I would like to change the Range to only looking at COLUMN A values if the cells in each ROW does not equal BLANK (nothing)

What would I change this to:
iNumRows = Selection.Rows.Count

See attached image of excel file.

[Kenneth Hobs]

Welcome to the forum!

I don't see why that would ever do what you said. It would sort of do that if you used UsedRange. Sounds like the second method shown here would meet your needs.

[VBA]Sub Test()
Dim r As Range
Set r = Worksheets("Sheet1").UsedRange
MsgBox r.Address, , "Includes Formatted Cells"

Set r = Worksheets("Sheet1").Range("A1", _
Worksheets("Sheet1").Range("E" & _
Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row))
MsgBox r.Address, , "Includes Only Used Range With Data"
End Sub[/VBA]

[mfleming]

Got it to work. Added an If Statement.

[VBA]
Set CurrRange = Range("A4:A5000") 'Sets Default Range
For rowIndex = 1 To CurrRange.Rows.Count 'Checks each cell and only adds cells with values
With CurrRange.Cells(rowIndex, 1)
If .Value <> "" Then
iNumRows = iNumRows + 1
End If

End With
Next rowIndex
[/VBA]

Full Code for anyone else:
[VBA]
Public bForm As Boolean
Private Sub Export_Click()

ExportToTXT

End Sub

Sub ExportToTXT()
'
' Exports the identified columne to a Comma Delimited Text File
' Last Revised 2/27/2009
'
Dim iTab As Integer
Dim iNumCols As Integer
Dim iNumRows As Integer
Dim iCol As Integer
Dim iRow As Integer
Dim sDestFolder As String
Dim sNewFileName As String
Dim sTextLine As String
Dim bContinue As Boolean
Dim CurrRange As Range
Dim rowIndex As Integer
Dim Answer As String
Dim MyNote As String




'Ask user to select the tabs
frmSelectTabs.Show

If bForm = False Then
MsgBox "Selection canceled by user.", vbInformation
Exit Sub
End If

sDestFolder = ""
sDestFolder = SelectFolder()

If sDestFolder = "" Then
MsgBox "Selection canceled by user.", vbInformation
Exit Sub
Else
For iTab = 0 To frmSelectTabs.lbTabs.ListCount - 1

If frmSelectTabs.lbTabs.Selected(iTab) = True Then
Worksheets.Item(frmSelectTabs.lbTabs.List(iTab)).Activate

Application.ActiveSheet.UsedRange 'This resets the used range
Application.ActiveSheet.UsedRange.Select
iNumCols = Selection.Columns.Count

Set CurrRange = Range("A4:A5000") 'Sets Default Range
For rowIndex = 1 To CurrRange.Rows.Count 'Checks each cell and only adds cells with values
With CurrRange.Cells(rowIndex, 1)
If .Value <> "" Then
iNumRows = iNumRows + 1
End If

End With
Next rowIndex


'Check to make sure there that the current tab actually has columns to be include in the export
bContinue = False
For iCol = 1 To iNumCols
If InStr(1, UCase(Cells(1, iCol).Value), "INCLUDE") <> 0 Or _
InStr(1, UCase(Cells(1, iCol).Value), "EXPORT") <> 0 Then
bContinue = True
End If
Next iCol

If bContinue = True Then
'Text File Overwrite Message Box
MyNote = "File Already Exists in Selected Folder" & vbNewLine & "---------------------------" & _
vbNewLine & ActiveSheet.Name & vbNewLine & "---------------------------" & vbNewLine & _
"Do you want to Overwrite the File?"



sNewFileName = sDestFolder & ActiveSheet.Name 'Creates the file
If FileFolderExists(sNewFileName) Then
'Display MessageBox
Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "File Already Exists in Selected Folder!")

If Answer = vbNo Then
MsgBox "Export Canceled By User"
'Sets the Active sheet
Worksheets(6).Activate
Range("A1").Select
End 'Ends Macro
End If
If Answer = vbYes Then
'ok Continue
End If
End If

Open sNewFileName For Output As #1

iRow = 3 'Sets Default Row starting point Default is 3
iNumRows = iNumRows + iRow 'Allows for range to be exported from starting point iRow

For iRow = 3 To iNumRows
sTextLine = ""
For iCol = 1 To iNumCols
If InStr(1, UCase(Cells(1, iCol).Value), "INCLUDE") <> 0 Or _
InStr(1, UCase(Cells(1, iCol).Value), "EXPORT") <> 0 Then
sTextLine = sTextLine & Cells(iRow, iCol).Value & ","
End If
Next iCol
sTextLine = Left(sTextLine, Len(sTextLine) - 1)
Print #1, sTextLine
Next iRow
Close #1
Range("A1").Select
Else
MsgBox ("The tab titled '" & ActiveSheet.Name & "' did not contain any columns to be included" & vbCr & _
"in the file export and was skipped.")
End If
End If
Next iTab

End If

Worksheets(6).Activate
Range("A1").Select

End Sub


Public Function FileFolderExists(strFullPath As String) As Boolean
' Check if a file or folder exists

On Error GoTo EarlyExit
If Not Dir(strFullPath, vbDirectory) = vbNullString Then FileFolderExists = True

EarlyExit:
On Error GoTo 0

End Function
[/VBA]

Form:
[VBA]

Private Sub UserForm_Activate()

Dim i As Integer
Dim sTabName As String

cbOK.Enabled = False
cbAllTabs.Enabled = True
cbAllTabs.Value = False

lbTabs.Clear
For i = 1 To Worksheets.Count
sTabName = Worksheets(i).Name
If UCase(Right(sTabName, 4)) = ".TXT" Then
lbTabs.AddItem (sTabName)
End If
Next i

End Sub
Private Sub lbTabs_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

If lbTabs.ListCount > 0 Then
cbOK.Enabled = True
Else
cbOK.Enabled = False
End If

End Sub

Private Sub cbAllTabs_Click()

Dim i As Integer

If cbAllTabs.Value = True Then
For i = 0 To lbTabs.ListCount - 1
lbTabs.Selected(i) = True
Next i
lbTabs.Enabled = False
cbOK.Enabled = True
Else
lbTabs.Enabled = True
cbOK.Enabled = True
End If

End Sub
Private Sub cbOK_Click()

bForm = True
Me.Hide

End Sub
Private Sub cbCancel_Click()

bForm = False
Me.Hide

End Sub

[/VBA]