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

T

Tayeda

New Member
Joined
Jul 29, 2017
Messages
5
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.
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Sort by date Sort by votes
Tayeda, welcome.

Maybe this will help.....

Code: 
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.
 
Upvote 0
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.
 
Upvote 0
Try just make the small change shown in red below.

Rich (BB code): 
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.
 
Last edited:
Upvote 0
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.
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

X
  • Question Question
VBA for extracting specific data from PDF Docs
Replies
3
Views
645
xcellrodeo
X
O
  • Question Question
Somewhat basic UDFs work except that they return #VALUE! error after hiding rows with VBA.
Replies
2
Views
111
OaklandJim
O
F
  • Question Question
VBA, Selection with xlToRight but want to end at column JK
Replies
3
Views
140
Joe4
Joe4
M
  • Question Question
VBA - Find first empty cell in a row
Replies
2
Views
509
Mplz
M
N
  • Solved
how to automatically clear text if text in another cell is removed
Replies
1
Views
111
Joe4
Joe4

Forum statistics

Threads
1,223,911
Messages
6,175,323
Members
452,635
Latest member
laura12345

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top