Find value and extract data - VBA

[jaybobo1040]

Hi everyone,

I have been going crazy as I am trying to create a Macro for work and I don't know how to do it the way I want.
Below is a very simplified version of the type of data I'll need to extract from this table and paste onto Sheet2 for example.

The idea is that if in Column 3, there is "TO INVOICE" then I would need to copy what is in both cells left of "TO INVOICE" onto Sheet2 and repeat it until there is no more "TO INVOICE" in that column.

My knowledge of VBA is non existant but I know it is the only way to do it as using formulas on Excel won't work.

ONE WORD <tbody> </tbody>	Champagne <tbody> </tbody>	TO INVOICE <tbody> </tbody>
BEER	FRANCE	TO INVOICE
CHEESE	CREAM
GIRLS	PARTY	TO INVOICE
CARS	FAST

<tbody>
</tbody>

Obviously in excel file there are hundreds of rows with data in there.

Any advice, VBA code I could use to get me out of this hole?

Your help would be very much appreciated.

Happy Friday.

Jay

 

[Rick Rothstein]

Below is a very simplified version of the type of data

I hate when I see the words above as it usually means important, needed information has been omitted. What exactly is in Column C... only blanks or the words "TO INVOICE" or could there be other values beside these?

 

[jaybobo1040]

Rick,

Apologies, I thought simplifying it would make it easier to do but yes true, all information are needed.

In Column C will either be the 3 following values (TO INVOICE, INVOICED, PENDING).
When there is TO invoice in column C then I would need to copy data on the same row into another sheet on the same workbook.

If in C1 there is TO INVOICE then I'd like to copy what is in A1 and B1 into another sheet.
I hope it is clearer ?

Thanks

 

[Nishant94]

Sub FilterData()
        
    Dim MyRng As Range
    Dim CurrentSheet As Worksheet
    
    Set CurrentSheet = ActiveSheet
    
    CurrentSheet.Rows("1:1").Insert SHIFT:=xlDown
    
    Set MyRng = Range("A1").Resize(Cells(Rows.Count, 1).End(xlUp).Row, 3)
    
    MyRng.AutoFilter Field:=3, Criteria1:="TO INVOICE"
    MyRng.Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    ActiveWorkbook.Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = InputBox("Please enter the name of the new sheet:", "Sheet Name")
    Range("A1").PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
    ActiveSheet.Rows("1:1").Delete
    CurrentSheet.Rows("1:1").Delete
    
End Sub

 

[jaybobo1040]

Thank you the code works but I would want to know if it could be slightly modified to only copy what is in columns A and B and not copy the column where it says TO INVOICE ?

 

[Nishant94]

Thank you the code works but I would want to know if it could be slightly modified to only copy what is in columns A and B and not copy the column where it says TO INVOICE ?

Sub FilterData()
        
    Dim MyRng As Range
    Dim CurrentSheet As Worksheet
    
    Set CurrentSheet = ActiveSheet
    
    CurrentSheet.Rows("1:1").Insert SHIFT:=xlDown
    
    Set MyRng = Range("A1").Resize(Cells(Rows.Count, 1).End(xlUp).Row, 3)
    
    MyRng.AutoFilter Field:=3, Criteria1:="TO INVOICE"
    MyRng.Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    ActiveWorkbook.Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = InputBox("Please enter the name of the new sheet:", "Sheet Name")
    Range("A1").PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
    ActiveSheet.Rows("1:1").Delete
    CurrentSheet.Rows("1:1").Delete
    ActiveSheet.Columns(3).EntireColumn.Delete

    
End Sub

 

[jaybobo1040]

Thank you very much for your help with this.

Problem was solved.

Thanks again.