locked
Work with Table outside the For Loop RRS feed

  • Question

  • Hi,

    I build the script (below) that allocate tables in 2 separate workbooks and copy data from one table to the other.

    the tables are available only in the for loop and i can't work with them outside of it.

    how can i work with them outside of the loop ?

    it is not critical for my script but i want to learn how to do it for the next scripts.

    thank you 

    Vered 


    Sub BST_Table_23_June()
    '
    'Define the DB as a table & Copy the row data from the BST Card . The Calculations are taking place in the BST Card


    'Allocate the Table in the BST Card file
     
      Dim BST_Card As Worksheet
      Dim BST_Card_Book As Workbook
      Dim BST_Card_Table As ListObject
      Dim BST_Card_Table_Name As String
      Dim TabName As String
      Dim BST_Card_LR, BST_Card_LC As Integer '* the number of the last row and colunm in the table
        
         
        Set BST_Card_Book = ActiveWorkbook
        Set BST_Card = ActiveSheet
           
        TabName = BST_Card_Book.ActiveSheet.Name
      
        'Debug.Print TabName
        
        For Each BST_Card_Table In BST_Card.ListObjects '* Allocating the name of the table in the BST_Card Sheet*'
            Application.Goto BST_Card_Table.Range
            BST_Card_Table_Name = BST_Card_Table.Name
            BST_Card_LR = BST_Card_Table.Range.Row + BST_Card_Table.ListRows.Count
            BST_Card_LC = BST_Card_Table.Range.Column + BST_Card_Table.ListColumns.Count
            
        Next
          
            
        Debug.Print BST_Card_LR
        Debug.Print BST_Card_LC
        
      Dim Pathname As String
      Dim Main_BST_DB As Workbook
      Dim BST_Main_DB_Sheet As Worksheet
      Dim BST_Main_DB_Table As ListObject
      Dim BST_Main_DB_Table_Name As String
      Dim BST_Main_DB_LR, BST_Main_DB_LC As Long
      Dim i, j As Long
     
      i = 1
     
      Pathname = "C:\Users\Software\Desktop\Main_BST_DB.xlsm" '*opening the main DB file *'
      Workbooks.Open Filename:=Pathname
     
      Set Main_BST_DB = ActiveWorkbook
     
      Set BST_Main_DB_Sheet = ActiveSheet
     
      BST_Main_DB_LC = 0
      BST_Main_DB_LR = 0
     
     
      For Each BST_Main_DB_Table In BST_Main_DB_Sheet.ListObjects  '* Allocating the name of the table in the BST_Main_DB Sheet*'
              Application.Goto BST_Main_DB_Table.Range
              BST_Main_DB_Table_Name = BST_Main_DB_Table.Name
              Debug.Print BST_Main_DB_Table_Name
              BST_Main_DB_Table.ListRows.Add                      '*adding blank last line in the mail DB *'
              BST_Main_DB_LC = BST_Main_DB_Table.Range.Column + BST_Main_DB_Table.ListColumns.Count
              BST_Main_DB_LR = BST_Main_DB_Table.Range.Row + BST_Main_DB_Table.ListRows.Count '* allocating the address of the last row in the main DB table
      
       Next
     
      Debug.Print BST_Main_DB_LR
      Debug.Print BST_Main_DB_LC

     
      ' Loop that Copy the cells from the Card to the Main DB

      For i = 1 To BST_Card_LC
         For j = 1 To BST_Card_LC
             If BST_Main_DB_Sheet.Cells(4, j) - BST_Card.Cells(4, i) = 0 Then
               If BST_Card.Cells(5, i).Value = "Yes" Then BST_Main_DB_Sheet.Cells(BST_Main_DB_LR, j) = BST_Card.Cells(BST_Card_LR, i)
             End If
             
         Next j
       Next i

       strPrompt = "Do you want to keep Main BST DB Open?"
      
        'Display MessageBox
         iRet = MsgBox(strPrompt, vbYesNo)
     
        ' Check pressed button
         If iRet = vbNo Then
              Main_BST_DB.Close SaveChanges:=True
       
         End If
       
     
    End Sub

    Thursday, June 26, 2014 6:33 AM

Answers

  • Re:  one table at a time

    Maybe something like this...
    '---
    Sub MyDogSpot()
     Call TransferValues(ActiveSheet.ListObjects(1), ActiveSheet.ListObjects(2))
    End Sub

    Function TransferValues(ByRef FirstTable As ListObject, _
                                      ByRef SecondTable As ListObject)
     Dim NewRow As ListRow
     Set NewRow = SecondTable.ListRows.Add
     NewRow.Range.Value = FirstTable.ListRows(FirstTable.ListRows.Count).Range.Value
     Set NewRow = Nothing
    End Function
    '---

    Jim Cone
    Portland, Oregon USA

    (free & commercial excel add-ins & workbooks)





    • Marked as answer by Vered Vera Sunday, June 29, 2014 12:23 PM
    • Edited by James Cone Thursday, October 20, 2016 3:14 PM
    Thursday, June 26, 2014 3:53 PM
  •  thank you ! i will check and advise if it worked :)
    • Marked as answer by Vered Vera Sunday, June 29, 2014 12:23 PM
    Sunday, June 29, 2014 9:09 AM

All replies

  • Re:  one table at a time

    Maybe something like this...
    '---
    Sub MyDogSpot()
     Call TransferValues(ActiveSheet.ListObjects(1), ActiveSheet.ListObjects(2))
    End Sub

    Function TransferValues(ByRef FirstTable As ListObject, _
                                      ByRef SecondTable As ListObject)
     Dim NewRow As ListRow
     Set NewRow = SecondTable.ListRows.Add
     NewRow.Range.Value = FirstTable.ListRows(FirstTable.ListRows.Count).Range.Value
     Set NewRow = Nothing
    End Function
    '---

    Jim Cone
    Portland, Oregon USA

    (free & commercial excel add-ins & workbooks)





    • Marked as answer by Vered Vera Sunday, June 29, 2014 12:23 PM
    • Edited by James Cone Thursday, October 20, 2016 3:14 PM
    Thursday, June 26, 2014 3:53 PM
  •  thank you ! i will check and advise if it worked :)
    • Marked as answer by Vered Vera Sunday, June 29, 2014 12:23 PM
    Sunday, June 29, 2014 9:09 AM