Posts by hugletank

$10 - Count rows between cells and add rows if needed

anyone?? would be willing to pay $10 usd if someone wants to move this to the hire help section

Re: Count rows between cells and add rows if needed

Having looked through some other posts on this forum, I found this code that identifies the number of instances of the criteria (in this case the text string start). It also works how how many rows is between each instance of the criteria occuring. It then puts that data into cell B1 of the active sheet.

This code was created by rbrhodes

Sub spaced()     
    Dim rowz()
    Dim i As Long
    Dim c As Range
    Dim found As Long
    Dim rownum As Long
    Dim lastrow As Long
    Dim fined As String
    Dim retstring As String
    Dim firstaddress As String
     
     'get lastrow col A
    lastrow = Range("A65536").End(xlUp).Row
     'set array
    ReDim rowz(lastrow)
     'input number to find
    fined = "start"
     'find it
    With Worksheets(1).Range("A1:A" & lastrow)
        Set c = .Find(fined, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstaddress = c.Address
             'store it
            i = 1
            rowz(i) = c.Row - 1
            rownum = c.Row + 1
             'number of times found
            found = 1
            Do
                 'increment array
                i = i + 1
                 'find again...
                Set c = .FindNext(c)
                 'store
                rowz(i) = (c.Row) - rownum
                rownum = c.Row + 1
                 'incr
                found = found + 1
            Loop While Not c Is Nothing And c.Address <> firstaddress
        End If
    End With
     'build string
    retstring = fined & " has " & found - 1 & " occurences. ("
     'populate
    For i = 1 To UBound(rowz)
        If rowz(i) > 0 Then
            retstring = retstring & rowz(i) & ", "
        ElseIf Right(retstring, 1) = "(" Then
             'not found at all
            Cells(1, 2) = Left(retstring, Len(retstring) - 1)
            Exit Sub
        Else
             'end population
            retstring = Left(retstring, Len(retstring) - 2) & ")"
            Exit For
        End If
    Next i
     
     '**CHANGE TO SUIT***
     'return value to ROW 1, COL 2 (B1)
    Cells(1, 2) = retstring




End Sub

I have tried adapting it to add rows but its way beyond me.

I have some data in column a which acts as heading, the same text is used for each heading. There could be up to 300 of these headings.

I would like to be able to count the number of rows from the first instance of this to the next. If its less than 50 rows, add rows until the range has 50 rows.

So for example, the first instance of this text is in cell A1, the second is in A51, third A72. The number of rows between the first 2 instances is 50 rows so nothing need be done. The number of rows between the second and third instance is only 21 rows so I need to add in 39 rows.

Can anyone help? Thanks.

Re: Loop and Delete ranges between page breaks

Hi maudibe, thanks again for the code.

I have just tested it on a sheet that has only 50 pages and I started it 30 minutes ago and its still working through them. I will generally be using worksheets with upto 300 pages. Is there anyway to speed the code up?

Re: Loop and Delete ranges between page breaks

Can anyone see why the code misses out the last range if meets the criteria to be deleted? I added a page break at the end of the data to see if that would solve it but unfortunately it doesn't.

Re: Loop and Delete ranges between page breaks

Hi Maudibe, I have added this code which seems to do the trick to some extent.

Sub RemovePasses()    
    Dim LastRow As Integer
    LastRow = Sheets("Sheet1").Range("a65536").End(xlUp).Row
    For r = LastRow To 1 Step -1
    
        Set c = Cells(r, 1)
        If c.Value = "no pass" Then
        c.Activate
        RemoveRange
        End If
    Next r
    
End Sub

I took the code you gave me to remove the range and renamed it RemoveRange. The above code then loops through column A to find multiple instances of the value I choose to have, in this case, "no pass", and then removes these ranges using the code you provided. The only problem with this is that if the final range in the sheet does meet the criteria, and therfore should be deleted, it doesnt delete this last range.

If you get chance, could you have a look and see why that might be?

I have added a sample workbook I've been working on.

Re: Loop and Delete ranges between page breaks

Thanks for that, that works well if I need to find one instance of a certain criteria.

Is there anyway of automating the process, so that you can look for a criteria in more than one range and it automatically finds every range fitting that criteria and deletes them? This would be useful as there could be 100+ pages and finding each instance could become time consuming.

I will have a go at modifying the code myself, but I fear much of the code is way above my level of knowledge.

I have a report that contains several rows of data. This data is separated by page breaks, so for example, there could be 1500 rows, separated into 90 pages by page breaks. Each range may have anywhere between 35 and 45 rows, but some of those rows may contain no data.

I would like to loop through the cells column A, look for a certain criteria, then delete the range around that certain cell that is contained within the page breaks.

I have code that will loop through the cells in column A. I also managed to create code that will delete a set range (using help from his forum), but since the ranges aren't always a uniform number of rows I need another fix.

Can anyone help?

Thanks in advance

Re: Insert Page Break Macro required

Thanks for this, just used this to solve my problem. :cheers:

Re: Delete range if cell within range meets criteria

I have added a new workbook with example data. Sheet 1 shows the original data before the code is run. Sheet 2 shows how I would like the data to look after the unwanted ranges have been deleted.

The code I created with the DO UNTIL works but I imagine there is a better way to achieve the same results.

Re: Delete range if cell within range meets criteria

Hi Jindon. That code only deletes the row that the value is in instead of the entire region around that cell, that is shaded green. The green range may not always have text in every cell, will always want deleting if the criteria is met.

Re: Delete range if cell within range meets criteria

Just worked out that if I put the code into a Do...Until loop for a few iterations, and slightly modify the range it seems to work.

This is the code I now have.

Sub NewTest()    
Do Until iCount = 2
    For Each c In Sheets("Sheet2").Range("a1:a200")
        If ((c.Value < 10) And (c.Value <> "")) Then
            c.Offset(-2, 0).Resize(9, 5).Delete
        End If
    Next
    iCount = iCount + 1
    Loop
End Sub

As I say, it works but it might just be luck that it works with my test data. Theres probably a better way to deal with the problem, so if anyone has any ideas about the initial code I would be grateful.

Thanks for your help so far PCI

Re: Delete range if cell within range meets criteria

I want it to ignore the blanks. The new code you have created removes the correct data. However, it adjusts the formatting. I need to only leave one blank row between each range of data. The code currently leaves between 1 and 3 blank rows between each range

I need to have one blank row at the top of the sheet and then a blank row in between each remaining range.

Re: Delete range if cell within range meets criteria

I have attached an example workbook that may help.

Eseentially, I want to look through the values in column A. If there is a value greater than 10, i want to delete the entire green area around that cell.

Re: Delete range if cell within range meets criteria

That didn't work either. Could this be because there are blank cells in the range I have selected?

I couldn't find an attached file

Re: Delete range if cell within range meets criteria

Having run some tests, it seems this line is at fault and the criteria is the issue.

If (cell.Value) > 10 Then

Re: Delete range if cell within range meets criteria

Thanks for the help.

That doesn't seem to work either.

I have some data in a worksheet. I am trying to look at all cells in column A and if there is a number greater than 10, it will delete a specified area around that cell.

The code I have so far is this but it doesn't work.

Sub NewTest()Range("a1:a74").Select
For Each cell In Selection
    If (cell.Value) > 10 Then
    cell.Offset(-1, 0).Resize(8, 5).Delete
    End If
Next   
End Sub

Can someone let me know where I've gone wrong?

Cheers.

Re: Copy row from one sheet to another - but paste in row 1

Thanks for the advice smallman, have been messing about with VB coding for ages but haven't gotten very good at it as you can see. :grin: (Just took me half an hour to work out that each cell in the row needs data in for that code to work also). Think I best do some courses!!

Was just happy that I managed to get it too work in the first place.

Incidentally, that link you provided doesnt seem to work.

Re: Copy row from one sheet to another - but paste in row 1

Thanks for the tips. So I guess its something to do with (2) at the end of the paste code that determines where the row is pasted too.