Find and copy table from worksheet

[Rmund89]

I'm just starting to dabble with VBA and may be in over my head as I really haven't programmed in a decade.

I have already written a macro that allows a user to point to a text file and bring it excel. These text files are the output of a modeling program we use at my workplace. What comes in is pasted in A1 and because the text file is space delimited the data all resides in Column A. What I need to do is have the macro go through this mass of text; find certain tables and copy and paste them to another sheet where they can be delimited into useable data. The tables have variable numbers of rows but a fixed number of columns (i.e. Table R2 will always have 2 columns and Table R3 will always have 4 columns in these output tables).

The macro needs to be able to scan the worksheet find Table R2 and copy out data beneath it. There will be a breakline of no data between each of the tables, but ideally the macro would find "Table R2" and then find "Table R3" and copy the data between them.

Example:

Table R1
Header1 Header2 Header3
A 2 3 15
B 3 6 12
C 4 7 20
D 8 5 18

Table R2
Header1 Header2
E 11 2
F 5 16
G 8 9

Table R3
Header1 Header2 Header3 Header 4
E 11 1 45 16
F 5 16 3 71
G 8 9 25 56
H 2 14 31 33
I 51 16 72 83


Any pointers would be much appreciated.

 

[Domenic]

Try...

<font face=Calibri><SPAN style="color:#00007F">Option</SPAN> <SPAN style="color:#00007F">Explicit</SPAN><br><br><SPAN style="color:#00007F">Sub</SPAN> CopyAndSeparateColumns()<br><br>    <SPAN style="color:#00007F">Dim</SPAN> rFound <SPAN style="color:#00007F">As</SPAN> Range<br>    <SPAN style="color:#00007F">Dim</SPAN> sTable <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br><br>    <SPAN style="color:#007F00">'Make sure a worksheet is the active sheet</SPAN><br>    <SPAN style="color:#00007F">If</SPAN> TypeName(ActiveSheet) <> "Worksheet" <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br>    <br>    <SPAN style="color:#007F00">'Specify the table for which to search</SPAN><br>    sTable = "Table R2"<br>    <br>    <SPAN style="color:#007F00">'Find the specified table in Column A of the active sheet</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> rFound = Columns("A").Find(what:=sTable, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)<br>    <br>    <SPAN style="color:#007F00">'If the table isn't found, exit the sub</SPAN><br>    <SPAN style="color:#00007F">If</SPAN> rFound <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN><br>        MsgBox sTable & " not found!", vbExclamation<br>        <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <br>    <SPAN style="color:#007F00">'Turn off screen updating</SPAN><br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    <br>    <SPAN style="color:#007F00">'If a worksheet for the specified table already exists, delete it</SPAN><br>    <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">Resume</SPAN> <SPAN style="color:#00007F">Next</SPAN><br>    Application.DisplayAlerts = <SPAN style="color:#00007F">False</SPAN><br>    Worksheets(sTable).Delete<br>    Application.DisplayAlerts = <SPAN style="color:#00007F">True</SPAN><br>    <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> 0<br>    <br>    <SPAN style="color:#007F00">'Add a new worksheet and name it after the specified table</SPAN><br>    Worksheets.Add(before:=Sheets(1)).Name = sTable<br>    <br>    <SPAN style="color:#007F00">'Copy the table to the new worksheet</SPAN><br>    rFound.CurrentRegion.Copy Range("A1")<br>    <br>    <SPAN style="color:#007F00">'Delete the first row containing the table name</SPAN><br>    Rows(1).Delete<br>    <br>    <SPAN style="color:#007F00">'Separate the data into columns</SPAN><br>    Range("A1").CurrentRegion.TextToColumns _<br>        Destination:=Range("A1"), _<br>        DataType:=xlDelimited, _<br>        textqualifier:=xlTextQualifierDoubleQuote, _<br>        consecutivedelimiter:=True, _<br>        Space:=<SPAN style="color:#00007F">True</SPAN><br>        <br>    <SPAN style="color:#007F00">'Turn screen updating back on</SPAN><br>    Application.ScreenUpdating = True<br>    <br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

Hope this helps!

 

[Rmund89]

Try...

<font face=Calibri><SPAN style="color:#00007F">Option</SPAN> <SPAN style="color:#00007F">Explicit</SPAN><br><br><SPAN style="color:#00007F">Sub</SPAN> CopyAndSeparateColumns()<br><br>****<SPAN style="color:#00007F">Dim</SPAN> rFound <SPAN style="color:#00007F">As</SPAN> Range<br>****<SPAN style="color:#00007F">Dim</SPAN> sTable <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br><br>****<SPAN style="color:#007F00">'Make sure a worksheet is the active sheet</SPAN><br>****<SPAN style="color:#00007F">If</SPAN> TypeName(ActiveSheet) <> "Worksheet" <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br>****<br>****<SPAN style="color:#007F00">'Specify the table for which to search</SPAN><br>****sTable = "Table R2"<br>****<br>****<SPAN style="color:#007F00">'Find the specified table in Column A of the active sheet</SPAN><br>****<SPAN style="color:#00007F">Set</SPAN> rFound = Columns("A").Find(what:=sTable, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)<br>****<br>****<SPAN style="color:#007F00">'If the table isn't found, exit the sub</SPAN><br>****<SPAN style="color:#00007F">If</SPAN> rFound <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN><br>********MsgBox sTable & " not found!", vbExclamation<br>********<SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br>****<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>****<br>****<SPAN style="color:#007F00">'Turn off screen updating</SPAN><br>****Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>****<br>****<SPAN style="color:#007F00">'If a worksheet for the specified table already exists, delete it</SPAN><br>****<SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">Resume</SPAN> <SPAN style="color:#00007F">Next</SPAN><br>****Application.DisplayAlerts = <SPAN style="color:#00007F">False</SPAN><br>****Worksheets(sTable).Delete<br>****Application.DisplayAlerts = <SPAN style="color:#00007F">True</SPAN><br>****<SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> 0<br>****<br>****<SPAN style="color:#007F00">'Add a new worksheet and name it after the specified table</SPAN><br>****Worksheets.Add(before:=Sheets(1)).Name = sTable<br>****<br>****<SPAN style="color:#007F00">'Copy the table to the new worksheet</SPAN><br>****rFound.CurrentRegion.Copy Range("A1")<br>****<br>****<SPAN style="color:#007F00">'Delete the first row containing the table name</SPAN><br>****Rows(1).Delete<br>****<br>****<SPAN style="color:#007F00">'Separate the data into columns</SPAN><br>****Range("A1").CurrentRegion.TextToColumns _<br>********Destination:=Range("A1"), _<br>********DataType:=xlDelimited, _<br>********textqualifier:=xlTextQualifierDoubleQuote, _<br>********consecutivedelimiter:=True, _<br>********Space:=<SPAN style="color:#00007F">True</SPAN><br>********<br>****<SPAN style="color:#007F00">'Turn screen updating back on</SPAN><br>****Application.ScreenUpdating = True<br>****<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

Hope this helps!

With some modest tweaking this is exactly what I needed! Thanks a ton.

 

[Domenic]

You're very welcome! And thanks for the feedback!