VBA for loop to copy row/column values in a dynamic region and paste to another workbook

[zacc05]

Hello! I am working to build a dynamic for loop/if statement but I am at my limits of VBA knowledge and need some help!

Objective: Loop through a dynamic range of asset, liability, and net asset cells that can change in row and column size, copy values that are populated (skipping blanks) and also grab the associated Fund Code value in Column B and account number in Row 4 of source file .
Attached Images: I have uploaded images of my source file and destination file (you can see what my code currently returns in the destination file)

Current State: My code currently works great for fixed cells but I need to expand it to accommodate more columns/rows. It currently loops through column D in the source file, skips the blanks, and returns the associated values in column B and pastes them in columns D and B of the destination file respectively, it also copies and pastes the fixed value in cell A3 and Cell D4 to column A and C in the destination file.

Goal: What I want to do to my code is make the source region dynamic, so it will loop through column D AND all columns and rows (ignoring the 5 header rows) to the right of column D and grab any populated values. I also want to make the acccount_num in source file D4 dynamic so it will grab the account number associated with the column it grabs the $$ value from. A source template that is filled out may have more or less Funds (columns) and Assets/liabilities/net assets (rows) so that's why it needs to be dynamic. I think I need to add a double for loop but not sure.

Let me know if I need to clarify anything!

Here is my code so far:

Public Sub import_FBI_data()


Dim FileToOpen As Variant
Dim OpenBook As Workbook

Dim wsSource As Worksheet
Dim wsDest As Worksheet

Dim i As Long
Dim j As Long
Dim lastrow1 As Long
Dim MY_LAST_ROW As Long


Application.ScreenUpdating = False



'Pop up to allow user to select which file they want to use as the source
 FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
    If FileToOpen <> False Then
        'Set variables for the source and destination workbooks.worksheets
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        Set wsSource = OpenBook.Worksheets("Template")
        Set wsDest = ThisWorkbook.Worksheets("gl_transactions")
       
        'Clear contents of destination range
        wsDest.Range("A3:A800").EntireRow.ClearContents
       
        'Identify last row and column of the source workbook and starting point for the double loop
        lastrow1 = wsSource.Cells(Rows.Count, 1).End(xlUp).Offset(-3, 0).Row
       
           
            'Loop through every row and column starting in row 6 column D and copy over any data that isn't blank with the associated values
            For i = 6 To lastrow1 Step 1
                If Not IsEmpty(Cells(i, "D")) Then
                    amount = wsSource.Cells(i, 4).Value
                    fund_code = wsSource.Cells(i, 2).Value
                    account_num = wsSource.Cells(4, 4).Value
                    post_code = wsSource.Cells(3, 1).Value
                   
                    'Identify last row of destination workbook
                     MY_LAST_ROW = wsDest.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
                   
                    'Identify where FBI data will copy to in destination workbook
                    With wsDest
                    wsDest.Cells(MY_LAST_ROW, 4).Value = amount
                    wsDest.Cells(MY_LAST_ROW, 2).Value = fund_code
                    wsDest.Cells(MY_LAST_ROW, 3).Value = account_num
                    wsDest.Cells(MY_LAST_ROW, 1).Value = post_code
                    End With
                End If
            Next i
    End If

OpenBook.Close False
   
Application.ScreenUpdating = True


End Sub

 

[offthelip]

Welcome to Mr Excel. I wasn't entriely sure about what you requirements are, but i have rewritten your code to use Varainta arrays which is about 1000 times faster when copying between worksheets. it means you don't have to keep swapping from one sheet to the other. I have also introduced the Col2Copy array which allows you to specify wha additional columns you wwant copied to the right of the 4 you have done already. I have also put the headers in the destination sheet. All of the code is untested so there may be some errors, note the line of the erros post back here if that is hte case;

Public Sub import_FBI_data()
Cols2copy = Array(4, 5, 6, 17)   ' the column numbers of columns to copy in addtion to Column 2 (B)
Dim outarr() As Variant


Dim FileToOpen As Variant
Dim OpenBook As Workbook

Dim wsSource As Worksheet
Dim wsDest As Worksheet

Dim i As Long
Dim j As Long
Dim lastrow1 As Long
Dim MY_LAST_ROW As Long


Application.ScreenUpdating = False ' Not necessary when using variant array cos it is realy fast and doesn't update the worksheet



'Pop up to allow user to select which file they want to use as the source
 FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
    If FileToOpen <> False Then
        'Set variables for the source and destination workbooks.worksheets
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        Set wsSource = OpenBook.Worksheets("Template")
        Set wsDest = ThisWorkbook.Worksheets("gl_transactions")
        'Clear contents of destination range
        wsDest.Range("A3:A800").EntireRow.ClearContents
        With wsSource  ' add this line
        'Identify last row and column of the source workbook and starting point for the double loop
        lastrow1 = .Cells(Rows.Count, "A").End(xlUp).Row
        lastcol = .Cells(1, .Columns.Count).End(xlToLeft).Column  'added this line
        inarr = .Range(.Cells(1, 1), .Cells(lastrow1, lastcol))    ' added this line to load all the data into a variant array
        ReDim outarr(1 To lastrow1, 1 To lastcol) ' define and array big enough for anythingi.e. the same size as the input arrray
                  
                    outarr(1, 1) = "post_date"  ' put the headers in
                    outarr(1, 2) = "fund_code"
                    outarr(1, 3) = "account_num "
                    outarr(1, 4) = "amount"
       
         End With
            'Loop  through every row and column starting in row 6 column D and copy over any data that isn't blank with the associated values
          With wsDest
            MY_LAST_ROW = .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
            Initialrow = MY_LAST_ROW
            For i = 6 To lastrow1 Step 1
                If Not IsEmpty(inarr(i, 4)) Then   ' modified
                 
                    'Identify last row of destination workbook
                 
                    'Identify where FBI data will copy to in destination workbook
                    outarr(MY_LAST_ROW, 4) = inarr(i, 4)
                    outarr(MY_LAST_ROW, 2) = inarr(i, 2)
                    outarr(MY_LAST_ROW, 3) = inarr(4, 4)
                    outarr(MY_LAST_ROW, 1) = inarr(3, 1)
                    ' add the other columns
                     For j = 0 To UBound(col2copy)
                       outarr(MY_LAST_ROW, 5 + j) = inarr(i, col2copy(j))
                       outarr(1, 5 + j) = inarr(1, col2copy(j))  ' put the header for this col in
                     Next j
                    MY_LAST_ROW = MY_LAST_ROW + 1
                End If
            Next i
             .Range(.Cells(Initialrow, 1), .Cells(MY_LAST_ROW - 1, lastcol)) = outarr ' write the results out
          End With
    End If

OpenBook.Close False
 
Application.ScreenUpdating = True


End Sub

 

[zacc05]

@offthelip Thank you very much for taking the time to write this!! I am not familiar with Variant arrays so I have a lot to learn. Two things:

1.) There is an error line 60 type 13 mismatch; image included

2.) For Col2Copy will it skip the blank values in each column and only grab the populated values? Also, will I need to update the code to specify the exact columns I want to copy each time the source file changes in column size?

I can also clarify my requirements if that would be helpful,

Thank you!

 

[offthelip]

Sorry that was a typo on my part change this line at the top:

Cols2copy = Array(4, 5, 6, 17)   ' the column numbers of columns to copy in addtion to Column 2 (B)

to

Col2copy = Array(4, 5, 6, 17)   ' the column numbers of columns to copy in addtion to Column 2 (B)

yes it will skip blank lines, this line does the check:

If Not IsEmpty(inarr(i, 4)) Then   ' modified

Note the similarity with your code instead of checking the cell I am checking the value in the array which was copied from the range, ie. the same value

 

[zacc05]

@offthelip just fixed it and it ran successfully, thank you. Now that I see how this is working here are the requirements/adjustments I need to make if you have any advice:

1.) The destination sheet can only contain the five existing columns. All values from columns D-R in source file need to be placed in column D of the destinations file; one line for each liability, asset, equity amount with the associated fund_code put into column B, and account_num (row 4) put into column C, and description (row 5) into column E (so for example fund code OP should have 10 lines) of destination file. Since the post date is the same for every entry Column A will always be equal to cell A3 of the source file for each line.

2.) I always want to ignore the bottom three rows of the source file. I had an offset for this so can I just add that back in?

I attached screenshots of how the code is working now vs. what I am going for. Let me know if this helps?

 

[offthelip]

I don't understand what you want
1: Do you want more than one row in the destination for each row in source?
2: If so how do I know what to put on each row?
3: Do you know which columns from the source you want where in the destination.
4: Are they always the same columns? Or do they always have the same header because I could check the header to find the columns

 

[zacc05]

I figured it out!! Here is my code (output image attached) hopefully that will help clear it up. Sorry for the confusion and thank you for taking the time to help me I really appreciate it!

Public Sub import_FBI_data()

Dim FileToOpen As Variant
Dim OpenBook As Workbook
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim i As Long
Dim j As Long
Dim lastrow1 As Long
Dim MY_LAST_ROW As Long

Application.ScreenUpdating = False

'Pop up to allow user to select which file they want to use as the source
 FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
    If FileToOpen <> False Then
        'Set variables for the source and destination workbooks.worksheets
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        Set wsSource = OpenBook.Worksheets("Template")
        Set wsDest = ThisWorkbook.Worksheets("gl_transactions")
        
        'Clear contents of destination range
        wsDest.Range("A2:A2000").EntireRow.ClearContents
        
        'Identify last row and column of the source workbook and starting point for the loop
        lastrow1 = wsSource.Cells(Rows.Count, 1).End(xlUp).Offset(-3, 0).Row
        lastcol = wsSource.Cells(5, Columns.Count).End(xlToLeft).Offset(0, -1).Column
            
            'Loop through every row and column starting in row 6 column D and copy over any data that isn't blank with the associated values
            For i = 6 To lastrow1 Step 1
                For j = 4 To lastcol Step 1
                    If Not IsEmpty(Cells(i, j)) Then
                        amount = wsSource.Cells(i, j).Value
                        fund_code = wsSource.Cells(i, 2).Value
                        account_num = wsSource.Cells(4, j).Value
                        post_code = wsSource.Cells(3, 1).Value
                        Description = wsSource.Cells(5, j).Value
                    
                        'Identify last row of destination workbook
                        MY_LAST_ROW = wsDest.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
                    
                        'Identify where FBI data will copy to in destination workbook
                        With wsDest
                        wsDest.Cells(MY_LAST_ROW, 4).Value = amount
                        wsDest.Cells(MY_LAST_ROW, 2).Value = fund_code
                        wsDest.Cells(MY_LAST_ROW, 3).Value = account_num
                        wsDest.Cells(MY_LAST_ROW, 1).Value = post_code
                        wsDest.Cells(MY_LAST_ROW, 5).Value = Description
                        End With
                    End If
                Next j
            Next i
    End If
OpenBook.Close False
    
Application.ScreenUpdating = True

End Sub