MrExcel.com - Your One Stop for Excel Tips & Solutions

Extracting Data from an Excel Table

Posted by Kev on December 18, 2000 1:33 PM

Any help with this problem would be appreciated.

I have a table with 18 columns and 3500 rows. Col 1 contains a six digit code which is reversed in Col 10 (eg. Col 1=aaabbb, then Col 10=bbbaaa). The table will contain several records with each code.
I need a report that creates a section for each unique code in Col 1, and pulls all the records with a matching code in Col 1 into the left hand side of that section, and all the records with a matching code in Col 10 into the right hand side of that section.

Is there a quick way of doing this?

Posted by Thomas Venn on December 20, 2000 2:12 PM

Hi,
try this.

Cheers,

Thomas

Sub Macro6()
'
Application.Goto Reference:="R1C1"
Application.Goto Reference:="R1C19"
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=COUNTIF(R1C1:R3500C1,RC[-18])"
Selection.Copy
Application.Goto Reference:="R1C19"
ActiveCell.Range("A1:A3499").Select
ActiveCell.Activate
ActiveSheet.Paste
Application.Goto Reference:="R1C1"
Application.CutCopyMode = False
Calculate
Application.Goto Reference:="R1C19"
ActiveCell.Columns("A:A").EntireColumn.Select
Calculate
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Calculate
Application.Goto Reference:="R1C19"
Application.Goto Reference:="R1C20"
ActiveCell.FormulaR1C1 = "=IF(RC[-1]>1,RC[-1],"""")"
ActiveCell.FormulaR1C1 = "=IF(RC[-1]>1,RC[-19],"""")"
Application.Goto Reference:="R1C21"
ActiveCell.FormulaR1C1 = "=IF(RC[-2]>1,"""",RC[-20])"
Application.Goto Reference:="R1C20"
ActiveCell.Range("A1:B1").Select
Selection.Copy
ActiveCell.Range("A1:B3500").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Calculate
Application.Goto Reference:="R1C20"
ActiveCell.Columns("A:B").EntireColumn.Select
Calculate
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.Goto Reference:="R1C20"
Application.CutCopyMode = False
Calculate
ActiveCell.Columns("A:A").EntireColumn.Select
Selection.Sort Key1:=ActiveCell, Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Application.Goto Reference:="R1C21"
ActiveCell.Columns("A:A").EntireColumn.Select
Selection.Sort Key1:=ActiveCell, Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Application.Goto Reference:="R1C20"
'End Sub
'Sub Macro7()
'
'
Application.Goto Reference:="R1C19"
ActiveCell.Columns("A:A").EntireColumn.Select
Selection.TextToColumns Destination:=ActiveCell, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, OtherChar _
:=".", FieldInfo:=Array(1, 1)
Application.Goto Reference:="R1C20"
ActiveCell.Columns("A:A").EntireColumn.Select
Selection.TextToColumns Destination:=ActiveCell, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, OtherChar _
:=".", FieldInfo:=Array(1, 1)
Application.Goto Reference:="R1C21"
ActiveCell.Columns("A:A").EntireColumn.Select
Selection.TextToColumns Destination:=ActiveCell, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, OtherChar _
:=".", FieldInfo:=Array(1, 1)
Application.Goto Reference:="R1C1"
Application.Goto Reference:="R1C19"
End Sub