Export Data From One Column Based on Another Column Excluding Headers

[Jeanpierre]

Hi, I have looked through various forums and tried my own code but to no avail.

I have a sheet with data in 9 columns. The information i need exported is in column A. But i need to export column A (without the heading) based on Column C. But save the file name as column D and column C with current date.
It sounds really simple.

I can send code I am trying to use but must warn you it is useless.

Would appreciate the help.

 

[bobaol]

hello, it would be helpful if you could copy and paste the data into here, not an image. hope this code works. Cheers!


Sub Macro64891_____setup()
'''assume your file is named: produce_desc.xlsm
Windows("produce_desc.xlsm").Activate

''assumes AA to right are empty for you, and you can use AA to work with
'''find the number of non-empty rows
Application.Goto Reference:="R1C28"
Selection.FormulaR1C1 = "'count of non-empty cells"
Application.Goto Reference:="R1C29"
Selection.FormulaR1C1 = "=COUNTA(R[1]C[-28]:R[1048574]C[-28])"
Selection.Copy
Application.Goto Reference:="R1C1"

''formulas in spreadsheet to determine where the items change
Application.Goto Reference:="R1C27"
ActiveCell.FormulaR1C1 = "header"
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.FormulaR1C1 = "=RC[-26]"
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.FormulaR1C1 = "=IF(RC[-1]=R[1]C[-1],"""",RC[-1])"
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.FormulaR1C1 = "=IF(RC[-1]="""","""",""Change6489"")"
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.FormulaR1C1 = "=INDEX(C[-29]:C[1397],MATCH(RC[-3],C[-2],0),29)"
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.FormulaR1C1 = "=COUNTIF(C[-4],RC[-4])"
Application.Goto Reference:="R2C27"
Selection.Copy
ActiveCell.Range("A1:E1").Select
Selection.Copy
'' was copied recorded code ActiveCell.Range("A1:E40").Select
''change code to use cell AC1, so it is variable number of cells
ActiveCell.Range("A1:E" & Range("ac1")).Select
ActiveSheet.Paste

Application.Run "Macro64892__Copy_paste_repeat_"


End Sub

Sub Macro64892__Copy_paste_repeat_()

''when it is done, it will cause an error.
''this is intentional, so you know it is all done
For i = 1 To 6489

Windows("produce_desc.xlsm").Activate

'clear AE1, so there is never anything in it.
''AE1 will need to be used later in the macro
Application.Goto Reference:="R1C31"
Application.CutCopyMode = False
Selection.Clear

''find the first value in AF, copy to AF1
Application.Goto Reference:="R1C31"
Selection.End(xlDown).Select
Selection.Copy
Application.Goto Reference:="R1C31"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.Goto Reference:="R1C30"
Selection.Clear
Application.Goto Reference:="R2C30"
''' ActiveCell.Range("A1:B44").Select
ActiveCell.Range("A1:B" & Range("ac1")).Select
''' Selection.Find(What:="19", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate
'''to find the first value based on ae1
Selection.Find(What:=Range("ae1"), After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.Copy
ActiveCell.Offset(0, -31).Range("A1").Select
Selection.Copy
'''copy based on the number of rows in ae1
''' ActiveCell.Range("A1:AF19").Select
ActiveCell.Range("A1:AF" & Range("ae1")).Select
Selection.Copy
'''paste to new workbook
Workbooks.Add
Application.Goto Reference:="R2C1"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'''add in date time in AG1 to AN1
Application.Goto Reference:="R1C33"
Selection.FormulaR1C1 = "=NOW()"
ActiveCell.Offset(0, 1).Range("A1").Select
Application.CutCopyMode = False
Selection.FormulaR1C1 = "=YEAR(RC[-1])"
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.FormulaR1C1 = "=RIGHT(""00""&MONTH(RC[-2]),2)"
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.FormulaR1C1 = "=RIGHT(""00""&DAY(RC[-3]),2)"
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.FormulaR1C1 = "=RIGHT(""00""&HOUR(RC[-4]),2)"
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.FormulaR1C1 = "=RIGHT(""00""&MINUTE(RC[-5]),2)"
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.FormulaR1C1 = "=RIGHT(""00""&SECOND(RC[-6]),2)"
ActiveCell.Offset(0, 1).Range("A1").Select
'''concatenate date time column D C in AN1
Selection.FormulaR1C1 = "=R[1]C[-36]&R[1]C[-37]&RC[-6]&RC[-5]&RC[-4]&""__""&RC[-3]&RC[-2]&RC[-1]&""__.xls"""

''save as based on cell AN1
'' it is currently saving to C:\temp2\
'' you can change it to whatever your need, like G:\mywork\
''' ActiveWorkbook.SaveAs Filename:="C:\temp2\save as AN1.xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.SaveAs Filename:="C:\temp2\" & Range("an1"), FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

'''clear AA to AQ
Application.Goto Reference:="R1C27"
ActiveCell.Columns("A:Q").EntireColumn.Select

'''clear your working columns, save again so it looks clean
Selection.Clear
Application.Goto Reference:="R1C1"
ActiveWorkbook.Save


'''go back to your original file
Windows("produce_desc.xlsm").Activate
''copy your selection, paste it to AA,
''then clear all of your working items
''since you already copied it to a new workbook
Selection.Copy
ActiveCell.Offset(0, 26).Range("A1").Select
ActiveSheet.Paste
Selection.Clear
Next
End Sub

 

[mumps]

It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).