VBA - Count rows until a specific text is found whithin a range

[Tayeda]

Hi there,
it's my first post to this forum, which has been quite useful for my first steps on VBA.

I need to loop through blocks of data set and export the data to a different sheet and predefined positions. I cant upload screen shots trough MrExcel add ins, so i will try to explain:

1. There are many blocks of data with similar structure,
2. They are all in one column,
3. Each start with a different code (for example F110000017), but all end with * Total" ,
4. The size of the blocks are not always the same,
5. Within each range there are both empty and non empty cells, positioned differently in each block.

My intention is to count the number of rows (empty + non empty) in one block. How can i do that in VBA? I will do the loop through the blocks.

I have succeeded in a similar task, but there were non empty cells only, so i was able to perform that by using Ctrl+Shift+Down. This case is just beyond my immature skills on VBA. Your help is very much welcome.

Best.

 

[Snakehips]

Tayeda, welcome.

Maybe this will help.....

Sub BlockData()


'Assumes column to search is C ie column 3
MyCol = 3  '*********Edit to suit************
'Assumes first row with data is row 2
BlockStart = 2  '***********edit to suit***********


LastRow = Cells(Rows.Count, MyCol).End(xlUp).Row
Set MyRange = Range(Cells(BlockStart, MyCol), Cells(LastRow, MyCol))
Set LastCell = Cells(LastRow, MyCol)


  Set FoundCell = MyRange.Find(What:="*total", After:=LastCell, LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False)
        
  If Not FoundCell Is Nothing Then
  FirstRow = FoundCell.Row
  Else
  MsgBox "No data blocks found"
  End If
  
   Do Until FoundCell Is Nothing


   'do stuff
   MsgBox "Block start = " & BlockStart & "    Block end = " & FoundCell.Row
   ' end of do stuff
   
   BlockStart = FoundCell.Row + 2  'assumes next block starts at 2 row under "Total" ????  Edit to suitif constant
   'otherwise need to program to find next block start row
   
   Set FoundCell = MyRange.FindNext(After:=FoundCell)
   If FoundCell.Row = FirstRow Then Exit Do
    
    Loop
    MsgBox "Data blocks processed"
End Sub

You do not specify which column so code assumes column C (3)
Also first row for first data block as row 2
Then first row of next block 2 rows below end of previous block,

Edit to suit your actual data. If start of next block not a known / constant below end of previous then will need to code to find the next data row down.

Test the above on a small data set or just step through the code then exit after a few loops since it is currently messaging the start / finish row of each block as an example of 'doing stuff'

Hope that helps.

 

[Tayeda]

Thank you so much Snakehips.

There is one issue. In previous thread, I thought it would be irrelevant to mention that, in every block, after "* Total" there is always "** Total". So the code is bringing "** Total" as next FoundCell, which i am not interested. Can you please help to skip it? I tried to use match and right functions, but without success.

Best.

 

[Snakehips]

Try just make the small change shown in red below.

Sub BlockData()


'Assumes column to search is C ie column 3
MyCol = 3  '*********Edit to suit************
'Assumes first row with data is row 2
BlockStart = 2  '***********edit to suit***********


LastRow = Cells(Rows.Count, MyCol).End(xlUp).Row
Set MyRange = Range(Cells(BlockStart, MyCol), Cells(LastRow, MyCol))
Set LastCell = Cells(LastRow, MyCol)


  Set FoundCell = MyRange.Find(What:="~* total", After:=LastCell, LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False)
        
  If Not FoundCell Is Nothing Then
  FirstRow = FoundCell.Row
  Else
  MsgBox "No data blocks found"
  End If
  
   Do Until FoundCell Is Nothing


   'do stuff
   MsgBox "Block start = " & BlockStart & "    Block end = " & FoundCell.Row
   ' end of do stuff
   
   BlockStart = FoundCell.Row + 2  'assumes next block starts at 2 row under "Total" ????  Edit to suitif constant
   'otherwise need to program to find next block start row
   
   Set FoundCell = MyRange.FindNext(After:=FoundCell)
   If FoundCell.Row = FirstRow Then Exit Do
    
    Loop
    MsgBox "Data blocks processed"
End Sub

I had assumed that you were wanting the * as a wildcard and so finding anything followed by "Total"
Using the Tilde (~) before the * means that the * will be treated as an actual character rather than a wildcard.

"? total" would also work in picking out "* Total" as the ? wildcard represents any single character. butthat would allow "X Total". etc if they exist.

Hope that helps.

 

[Tayeda]

That just worked perfectly. Next, i am going to integrate that piece into my code in order to loop through blocks and sub-blocks of data.

Thank you so much, Snakehips.

 

[Snakehips]

That's great. You are welcome.

 

[Tayeda]

Hi all/Snakehips,

I have an error in the line below shown in red, "Run time error 5: Invalid procedure call or argument". It runs only the first loop (or first "cell") and then the error appears on its way to the next "cell".
Can someone please help? It'll be gratefully appreciated.


Sub Invoices()

Dim extract As Worksheet
Dim GoodData As Worksheet
Dim cell As Range
Dim i As Long
Dim firstAddress As Variant
Dim total As Range

Dim FoundCell As Range
Dim FirstRow As Long
Dim BlockStart As Long
BlockStart = 15

Set extract = Sheets("Extracts 0011")
Set GoodData = Sheets("GoodData")

Set cell = Range("C:C").Find("Vendor*", LookIn:=xlValues)

Set FoundCell = Range("E:E").Find(What:="~* Total", LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False) '"After" option removed

If Not cell Is Nothing Then

firstAddress = cell.Address


Do


If Not FoundCell Is Nothing Then
FirstRow = FoundCell.Row
Else
MsgBox "No data blocks found"
End If

Do Until FoundCell Is Nothing


Dim Blockrows As Long
Blockrows = (FoundCell.Row - BlockStart) - 1


For i = 1 To Blockrows Step 2


GoodData.Cells(GoodData.Rows.Count, 1).End(xlUp).Offset(1, 0).Value = cell.End(xlDown).Offset(0, 2).End(xlDown).Value 'payment/exception
GoodData.Cells(GoodData.Rows.Count, 1).End(xlUp).Offset(0, 5).Value = cell.Offset(1, 0).Value 'supplier name

'address details
GoodData.Cells(GoodData.Rows.Count, 1).End(xlUp).Offset(0, 18).Value = cell.Offset(2, 0).Value
GoodData.Cells(GoodData.Rows.Count, 1).End(xlUp).Offset(0, 19).Value = cell.Offset(3, 0).Value
GoodData.Cells(GoodData.Rows.Count, 1).End(xlUp).Offset(0, 20).Value = cell.Offset(4, 0).Value
GoodData.Cells(GoodData.Rows.Count, 1).End(xlUp).Offset(0, 21).Value = cell.Offset(5, 0).Value

'Other details

GoodData.Cells(GoodData.Rows.Count, 1).End(xlUp).Offset(0, 25).Value = cell.End(xlDown).Offset(0, 2).End(xlDown).Offset(i, 0).Value 'CoCode
GoodData.Cells(GoodData.Rows.Count, 1).End(xlUp).Offset(0, 19).Value = cell.End(xlDown).Offset(0, 2).End(xlDown).Offset(i + 1, 0).Value 'ISR Number
GoodData.Cells(GoodData.Rows.Count, 1).End(xlUp).Offset(0, 1).Value = cell.End(xlDown).Offset(0, 2).End(xlDown).Offset(i, 4).Value 'Vendor No
GoodData.Cells(GoodData.Rows.Count, 1).End(xlUp).Offset(0, 20).Value = cell.End(xlDown).Offset(0, 2).End(xlDown).Offset(i + 1, 8).Value 'ISR Reference Number
GoodData.Cells(GoodData.Rows.Count, 1).End(xlUp).Offset(0, 2).Value = cell.End(xlDown).Offset(0, 2).End(xlDown).Offset(i, 12).Value 'Doc No
GoodData.Cells(GoodData.Rows.Count, 1).End(xlUp).Offset(0, 4).Value = cell.End(xlDown).Offset(0, 2).End(xlDown).Offset(i, 18).Value 'payment type
GoodData.Cells(GoodData.Rows.Count, 1).End(xlUp).Offset(0, 3).Value = cell.End(xlDown).Offset(0, 2).End(xlDown).Offset(i, 17).Value 'Supplier Invoice No
GoodData.Cells(GoodData.Rows.Count, 1).End(xlUp).Offset(0, 13).Value = cell.End(xlDown).Offset(0, 2).End(xlDown).Offset(i, 10).Value 'Park code
GoodData.Cells(GoodData.Rows.Count, 1).End(xlUp).Offset(0, 7).Value = cell.End(xlDown).Offset(0, 2).End(xlDown).Offset(i, 30).Value 'posting date
GoodData.Cells(GoodData.Rows.Count, 1).End(xlUp).Offset(0, 8).Value = cell.End(xlDown).Offset(0, 2).End(xlDown).Offset(i, 24).Value 'date 2
GoodData.Cells(GoodData.Rows.Count, 1).End(xlUp).Offset(0, 10).Value = cell.End(xlDown).Offset(0, 2).End(xlDown).Offset(i, 38).Value 'type 1
GoodData.Cells(GoodData.Rows.Count, 1).End(xlUp).Offset(0, 6).Value = cell.End(xlDown).Offset(0, 2).End(xlDown).Offset(i, 39).Value 'value
GoodData.Cells(GoodData.Rows.Count, 1).End(xlUp).Offset(0, 12).Value = cell.End(xlDown).Offset(0, 2).End(xlDown).Offset(i, 46).Value 'currency
GoodData.Cells(GoodData.Rows.Count, 1).End(xlUp).Offset(0, 11).Value = cell.End(xlDown).Offset(0, 2).End(xlDown).Offset(i, 48).Value 'Type 2
GoodData.Cells(GoodData.Rows.Count, 1).End(xlUp).Offset(0, 9).Value = cell.End(xlDown).Offset(0, 2).End(xlDown).Offset(i, 33).Value 'Net due date

'Bank details
'use transpose method for bank and adress details

GoodData.Cells(GoodData.Rows.Count, 1).End(xlUp).Offset(0, 14).Value = cell.Offset(1, 43).Value
GoodData.Cells(GoodData.Rows.Count, 1).End(xlUp).Offset(0, 15).Value = cell.Offset(2, 43).Value
GoodData.Cells(GoodData.Rows.Count, 1).End(xlUp).Offset(0, 16).Value = cell.Offset(3, 43).Value
GoodData.Cells(GoodData.Rows.Count, 1).End(xlUp).Offset(0, 17).Value = cell.Offset(4, 43).Value
GoodData.Cells(GoodData.Rows.Count, 1).End(xlUp).Offset(0, 18).Value = cell.Offset(5, 43).Value


Next


Set cell = Range("C:C").FindNext(cell)

Set FoundCell = Range("E:E").FindNext(after:=FoundCell)
BlockStart = FoundCell.Row + 15

If FoundCell.Row = FirstRow Then Exit Do
Loop

Loop While Not cell Is Nothing And cell.Address <> firstAddress

End If


MsgBox "Report created"

End Sub

 

[Tayeda]

Hi everybody,
Is there somebody who can help with my query please? I still cant find the solution and I am really in need.

Thank you