Macro para eliminar dados especificos.

[Fausto Genaro]

Boa noite galera.
Eu tenho varias planilhas geradas por um programa e preciso eliminar todos os dados existentes entro dois pontos. Esses pontos são marcados pela palavra origem. Acontece que as vezes os dados contidos entre as duas palavras origens somam 30 linhas, as vezes 5 linhas, as vezes 80 linhas o que impossibilita a criação de uma macro simples. Alguem sabe uma macro que pode eliminar essa minha dor de cabeça? Obrigado

 

[Fazza]

Boa noite (?), Fausto Genaro.

I think you meant to post this in the non-English section?

Sorry I can not help in your language. Obrigado, Fazza

 

[Fausto Genaro]

Hi Fazza,
I have several spreadsheets generated by a program and must remove all existing data do two points. These points are marked by the word origin. It happens sometimes that the data contained words between the two sources totaling 30 lines, sometimes 5 lines, the lines 80 times what makes the creation of a macro simple. Do you know a macro that can eliminate that my headache? Thank you

 

[Fazza]

Fausto,

I know enough VBA to help. Just need to understand exactly what is wanted.

VBA can use .Find to know the ranges containing the word "origin".

Between the first "origin" and the second "origin" what is to be done? Clear cells/ranges, clear rows or columns, delete cells/ranges, delete rows or columns?

Regards, Fazza

 

[Fausto Genaro]

Thank you Fazza,
I am writing below is as in Excel and I need to eliminate.
Origin BI
1 st
2 nd
3 rd
4 th
Origin BL
1 st
2 nd
3 rd
4 th
Origin CT + TD
I need to delete all the lines that are between Origin BI and Origin CT + TD so that the lines below the original CT + TD rise.

Sorry for my English.

Tanks

Fausto

 

[Fazza]

No problems with the English, Fausto.

So some more discussion first.

1. One way would be to apply an autofilter on the column for all the records that do not contain "origin". And then delete every row that is showing. This would only leave rows that contain "origin". So a little different from just between the first two pairs of appearance of the word "origin"

2. Are there only two blocks of rows to be deleted?

3. Are there only two blocks of rows to be deleted? If not, will it be OK to have code just for the first two and you will modify that to suit others.

4. Are there only two blocks of rows to be deleted? If not, should I write code to take out more rows after the first two blocks.

I'll start on some code to do just #2 because that seems to be what you have asked.

Regards, Fazza

 

[Fazza]

This should help, Fausto. Regards, Fazza

Sub remove_two_blocks()
 
  Dim rngStartOfBlock As Range
  Dim rngEndOfBlock As Range
 
  Set rngStartOfBlock = Cells.Find(What:="origin", After:=Cells(Cells.Rows.Count, Cells.Columns.Count), _
      LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
 
  If Not rngStartOfBlock Is Nothing Then
 
    Set rngEndOfBlock = Cells.Find(What:="origin", After:=rngStartOfBlock, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
 
    If Not rngEndOfBlock Is Nothing Then Rows(rngStartOfBlock.Row + 1 & ":" & rngEndOfBlock.Row - 1).Delete Shift:=xlUp
 
    Set rngEndOfBlock = Cells.Find(What:="origin", After:=rngStartOfBlock.Offset(1), _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
 
    If Not rngEndOfBlock Is Nothing Then Rows(rngStartOfBlock.Row + 2 & ":" & rngEndOfBlock.Row - 1).Delete Shift:=xlUp
  End If
 
End Sub

 

[Fazza]

Just thought after posting that the code will error if "origin" is in cells on successive rows - no rows to delete. Also it is easy to modify the code to suit multiple deletions.

I'll amend the code and re-post soon. Ciao, F

 

[Fazza]

Fausto, This will be better. Adjust to suit. Regards, Fazza

Sub remove_lots_of_blocks()
  Dim i As Long
  Dim rngStartOfBlock As Range
  Dim rngEndOfBlock As Range
  Application.ScreenUpdating = False
  Set rngStartOfBlock = Cells.Find(What:="origin", After:=Cells(Cells.Rows.Count, Cells.Columns.Count), _
      LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
  If rngStartOfBlock Is Nothing Then Exit Sub
  Do
    Set rngEndOfBlock = Cells.Find(What:="origin", After:=rngStartOfBlock.Offset(i))
    If rngEndOfBlock Is Nothing Or rngStartOfBlock.Row = rngEndOfBlock.Row Then Exit Do
    i = i + 1
    If rngStartOfBlock.Offset(i).Row <> rngEndOfBlock.Row Then _
        Rows(rngStartOfBlock.Row + i & ":" & rngEndOfBlock.Row - 1).Delete Shift:=xlUp
  Loop
End Sub

 

[Fausto Genaro]

Thank you very much. I will be forever grateful. I can mandar more a problem for you to help me or already took their time too?