vbarowsareas

vba legacy function to return row count returns 1 instead


I'm working with some legacy code I'd like to build on and I can't seem to figure out the following: Why does the function AantalZichtbareRows return 1? Where It says For Each row In rng.Rows the row count is 1500 something (and so is the actual excel I'm working with).

I'm specifically puzzeled by n = r.Areas.Count. This is where the 1 originates.

Sub motivatieFormOpmaken()

Public iLaatsteKolom As Integer
Public iLaatsteRij As Integer
Public iKolomnrCorpID As Integer
Public iKolomnrNaam As Integer
Public iKolomnrHuidigeFunctie As Integer

Const StBestand = "Stambestand.xlsm"
Const motivatie = "Template motivatieformulier opstapregeling.xlsx"

    Dim wbMotivTemp As Workbook
    Dim wsMotiv As Worksheet
    Dim PathOnly, mot, FileOnly As String
    Dim StrPadSourcenaam As String

    Set wbMotivTemp = ThisWorkbook
    Set wsMotiv = ActiveSheet

    StrHoofdDocument = ActiveWorkbook.Name
    StrPadHoofdDocument = ActiveWorkbook.Path
    StrPadSourcenaam = StrPadHoofdDocument & "\" & c_SourceDump

    If Not FileThere(StrPadSourcenaam) Then
       MsgBox "Document " & StrPadSourcenaam & " is niet gevonden."
    Exit Sub
    End If

    Application.ScreenUpdating = False

    Workbooks.Open FileName:=StrPadSourcenaam
    Application.Run "Stambestand.xlsm!unhiderowsandcolumns"
    Worksheets("stambestand").Activate

    iLaatsteKolom = Worksheets("stambestand").Cells.SpecialCells(xlLastCell).Column
    iLaatsteRij = Worksheets("stambestand").Cells.SpecialCells(xlLastCell).row

    VulKolomNr
    If KolomControle = False Then Exit Sub

    Aantalregels = AantalZichtbareRows
        Dim rng As Range
        Dim row As Range
        Dim StrFileName As String
        'If Aantalregels > 1 Then
         Set rng = Selection.SpecialCells(xlCellTypeVisible)
         For Each row In rng.Rows
              iRijnummer = row.row
              If iRijnummer > 1 Then
                 wsMotiv.Range("motiv_cid") = Cells(iRijnummer, iKolomnrCorpID).Text
                 wsMotiv.Range("motiv_naam") = Cells(iRijnummer, iKolomnrNaam).Text
                 wsMotiv.Range("motiv_ldg") = Cells(iRijnummer, iKolomnrHuidigeLeidingGevende).Text

                 n = naamOpmaken
                 wbMotivTemp.Activate
                 ActiveWorkbook.SaveAs FileName:=StrPadHoofdDocument & "\Docs\" & n & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
              End If
         Next row

End Sub

Function naamOpmaken() As String
    Dim rng As Range
    Dim row As Range
    Set rng = Selection.SpecialCells(xlCellTypeVisible)

    iRijnummer = rng.row
        If iRijnummer > 1 Then
            naam = Cells(iRijnummer, iKolomnrNaam).Text
            ldg = Cells(iRijnummer, iKolomnrHuidigeLeidingGevende).Text
            cid = Cells(iRijnummer, iKolomnrCorpID).Text

            Dim Position As Long, Length As Long
            Dim n As String
            Position = InStrRev(naam, " ")
            Length = Len(naam)
            n = Right(naam, Length - Position)
        End If
    naamOpmaken = n + "-" + ldg + "-" + cid
End Function

Public Function AantalZichtbareRows() As Integer
    Dim rwCt As Long
    Dim r As Range
    Dim n As Long
    Dim I As Long
        Set r = Selection.SpecialCells(xlCellTypeVisible)
        n = r.Areas.Count
            For I = 1 To n
              rwCt = rwCt + r.Areas(I).Rows.Count
            Next I
        AantalZichtbareRows = rwCt
End Function

Solution

  • Range.areas specifies the number of selection areas. Range.Areas

    I tested your code and it works as expected. You can have a single selection area containing 1500 rows. Example: "A1:A1500" Or you can have a selection containing 2 areas with three rows each for a total of 6 rows. Example: "A1:A3" and "C4:C6".

    This code might help you understand how the method returns information about the selected cells.

    Public Function AantalZichtbareRows() As Integer
        Dim rwCt As Long
        Dim rwCt2 As Long
        Dim r As Range
        Dim n As Long
        Dim I As Long
    
        Set r = Selection.SpecialCells(xlCellTypeVisible)
        n = r.Areas.Count
        For I = 1 To n
          rwCt = rwCt + r.Areas(I).Rows.Count
        Next I
    
        Set r = Selection
        n = r.Areas.Count
        For I = 1 To n
          rwCt2 = rwCt2 + r.Areas(I).Rows.Count
        Next I
    
        Debug.Print n & " areas selected."
        Debug.Print rwCt2 & " rows selected."
        Debug.Print rwCt & " visible rows selected."
        Debug.Print (rwCt2 - rwCt) & " hidden rows selected."
    
        AantalZichtbareRows = rwCt
    End Function