VBA Question - Looping and Variable Table - Not actual table

[MrMisster]

Hi,

I am an amateur with VBA, but have been using MrExcel and various to put code together for a project I am working on. I am currently stuck on a part where I have 2 "Table" copied to a sheet. The "tables" are variable in the sense of Rows, since there could be 1 query on it or 10 for example.

I am unable to change the state of the information prior to it being copied to the sheet.

Example of the "Table" with information removed due to sensitivity.

So I have tried using a Static range, If statements and even region select to try and get something workable, but I just cannot.

Simply put I would like the data grabbing and transferring to another sheet with an actual table, without the "Details" row if possible that can be skipped. the best way I can see this being done is Looping but I cannot seem to get my head around the way it works and get a workable Sub going.

The best shot I have had at it is using code from other various sources, but I have written nothing I can give you at the moment.

If you need more information or you can give me any examples, that would be most appreciated.

Thanks!

 

[sijpie]

Let me get this straight: You have the example table in sheet 1, and you want to copy the table to sheet2 but leaving out some of the rows.

There are two ways to do this:
Set a range to the table, copy and paste this to the 2nd sheet. Then do a range.Find / Findnext loop on the copy to find each of the 'Details' rows an delete those rows.

or

Read the Table1 into an array, using a loop count (in the array) how many rows will be removed, then set an outpu array to the right size. Then again loop through the 1st array, copying each 'cell' to the output array, skipping the lines that need to be removed. Then dump the output array to the 2nd sheet.

Both options are about the same amount of work. Arrays work blindingly fast, and you only have one read and one write action, which take up most time. With the first method, depending on the size of the tables, you have a larger amount of read and write actions. But if the tables are about as large as your example, then speed difference will be couple of seconds at the most.

 

[MrMisster]

Thanks for the response.

Option 1 sounds similar to what I have been trying to do, however I have been unable to set a variable range. The tables will never be huge, between 1-10 rows each table.

The hardest part I was struggling with was setting the range for the second table, as the first table will always start in a selected cell, however table 2s headers will be in a different row dependent on how many rows table 1 has.

I will have a look into range.find thanks.

 

[sijpie]

Sub CopyTable()
'-----------------------------------
'- Copy table to diferent location -
'- and then remove all rows with   -
'- 'Detail' in the first column    -
'-----------------------------------
    Dim rIn As Range, rOut As Range
    Dim rFound As Range
    Dim lR As Long, lC As Long
    Dim wsIn As Worksheet, wsOut As Worksheet
    
    Set wsIn = Sheets("Sheet1") ' <<< modify the two sheet  names to reflect yours
    Set wsOut = Sheets("Sheet2")
    
    Set rIn = wsIn.Range("B2").CurrentRegion    '<<< modify the cell to reflect a cell in the iinput table
    Set rOut = wsOut.Range("D4")                '<< modify to the cell where the output table starts
    
    'copy the table to the sheet and cell defined above
    rIn.Copy rOut
    'get the columns count
    lC = rIn.Columns.Count
    
    'set the out range to the first column, where you will be looking for 'Detail'
    Set rOut = rOut.Resize(rIn.Rows.Count, 1)
    
    'Now find the first occurance of 'Detail'
    Set rFound = rOut.Find("Detail")
    ' Because you will be deleting the row, this 'Detail' will disappear. _
      So you do not need to check if you already have been here.
    
    'Check if something has been found, then delete that row of the table
    Do While Not rFound Is Nothing
        rFound.Resize(1, lC).Delete xlUp
        Set rFound = rOut.FindNext
    Loop
    
    'clean up
    Set wsIn = Nothing
    Set wsOut = Nothing
    Set rIn = Nothing
    Set rOut = Nothing
    
End Sub

 

[MrMisster]

Sub CopyTable()
'-----------------------------------
'- Copy table to diferent location -
'- and then remove all rows with   -
'- 'Detail' in the first column    -
'-----------------------------------
    Dim rIn As Range, rOut As Range
    Dim rFound As Range
    Dim lR As Long, lC As Long
    Dim wsIn As Worksheet, wsOut As Worksheet
   
    Set wsIn = Sheets("Sheet1") ' <<< modify the two sheet  names to reflect yours
    Set wsOut = Sheets("Sheet2")
   
    Set rIn = wsIn.Range("B2").CurrentRegion    '<<< modify the cell to reflect a cell in the iinput table
    Set rOut = wsOut.Range("D4")                '<< modify to the cell where the output table starts
   
    'copy the table to the sheet and cell defined above
    rIn.Copy rOut
    'get the columns count
    lC = rIn.Columns.Count
   
    'set the out range to the first column, where you will be looking for 'Detail'
    Set rOut = rOut.Resize(rIn.Rows.Count, 1)
   
    'Now find the first occurance of 'Detail'
    Set rFound = rOut.Find("Detail")
    ' Because you will be deleting the row, this 'Detail' will disappear. _
      So you do not need to check if you already have been here.
   
    'Check if something has been found, then delete that row of the table
    Do While Not rFound Is Nothing
        rFound.Resize(1, lC).Delete xlUp
        Set rFound = rOut.FindNext
    Loop
   
    'clean up
    Set wsIn = Nothing
    Set wsOut = Nothing
    Set rIn = Nothing
    Set rOut = Nothing
   
End Sub

Hi Sijpie,

Thank you very much for the code, it works perfectly for the first table. However the table with the dynamic start point underneath does not copy over.

From what I understand of your code, this will only select the first table based on the initial range input I put in and does not look for the second one, which I think I can do by looking at Region Selection. The removal of the Detail rows works perfectly and I will definitely be using that, thank you.

Essentially my main problem is that the second table under the first one in my screenshot has a dynamic start point which is based on the rows of the first table, I am struggling to find a way to find that table and run what would essentially be the code above on both tables to make one table in a new tab.

Thanks!

 

[sijpie]

That will be quite simple to add. I'll fix it next week

 

[sijpie]

Sub CopyTable()
'-----------------------------------
'- Copy table to diferent location -
'- and then remove all rows with   -
'- 'Detail' in the first column    -
'-----------------------------------
    Dim rIn As Range, rOut As Range
    Dim rFound As Range
    Dim lR As Long, lC As Long
    Dim wsIn As Worksheet, wsOut As Worksheet
    
    Set wsIn = Sheets("Sheet1") ' <<< modify the two sheet  names to reflect yours
    Set wsOut = Sheets("Sheet2")
    
    Set rIn = wsIn.Range("B2").CurrentRegion    '<<< modify the cell to reflect a cell in the iinput table
    Set rOut = wsOut.Range("D4")                '<< modify to the cell where the output table starts
    
    'copy the table to the sheet and cell defined above
    rIn.Copy rOut
    'get the 2nd table
   Set rIn = wsIn.Cells(Rows.Count,2).End(xlUp).CurrentRegion
   'copy the table to below the previous
   rIn.Copy rOut.Offset(rOut.Rows.Count,0)
    'get the columns count
    lC = rIn.Columns.Count
    
    'set the out range to the first column, where you will be looking for 'Detail'
    Set rOut = rOut.Resize(rIn.Rows.Count, 1)
    
    'Now find the first occurance of 'Detail'
    Set rFound = rOut.Find("Detail")
    ' Because you will be deleting the row, this 'Detail' will disappear. _
      So you do not need to check if you already have been here.
    
    'Check if something has been found, then delete that row of the table
    Do While Not rFound Is Nothing
        rFound.Resize(1, lC).Delete xlUp
        Set rFound = rOut.FindNext
    Loop
    
    'clean up
    Set wsIn = Nothing
    Set wsOut = Nothing
    Set rIn = Nothing
    Set rOut = Nothing
    
End Sub