Help with my VBA to loop/copy paste based on value on source tab

mikestorm

New Member
Joined
Feb 3, 2021
Messages
9
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hi all. Normally when I get stuck I post on Reddit, and I almost always find a path forward, but not so this time so I decided to post here.

Background:
My company uses an application that imports records into QuickBooks, but is super slow and can time out. The solution is to cut the file to be imported into roughly equivalent chunks. Rather than manually carve up the file, I figured I'd create a macro to do it, but I can't seem to get the row ranges to work correctly.

There are about 650 customers on the file, with 2-15 lines per customer. The source tab has a customer counter. I want the macro to spin off files of 100 customers each, so seven files with the last file containing fifty customers.

Source file example:
Example.jpg


The macro correctly does the following:

  1. Imports the raw source file (works)
  2. Determines the max number of customers for loop stopping purposes (works)
  3. Gets the row number of the last record of customer 100 (works)
  4. Copies records for Customer 1 through Customer 100 (first iteration works)
  5. Spins off that chunk to it's own file (works)
  6. Increments customer count to 200 (works)
  7. Gets the row number of the last record of customer 200 (works)
6) Repeats the above for the second 100 customers until all customers have been spun off (this part is not working)

7) The macro goes through the loop the correct number of times

8) The macro correctly finds the row number of the last record of customer 100, 200, etc

9) The macro spins off each file in the proper format

The macro isn't moving the goalposts during each iteration (step 6). The first iteration works perfectly, but the second iteration should start at the row AFTER the first Iteration. Instead it always starts back at Row 1, even though it moves the proper tailored row count for customers 101-200, 201-300 etc..

So if the row count between customer 1 and 100 is 1026, it correctly gests a 1026 row range, copes pastes and spins off the csv. If the row count between customer 101 and 200 is 1146, it correctly gets an 1146 row range, but always starts back at row 1.

What am I doing wrong? Range interval is correct but starting point is always row 1. I can I make each loop of the macro start at the row number directly after where the prior loop left off so it spin off the correct range of rows?

Here's my code:

VBA Code:
Sub FileSplitter()

    'Varabiles
    Dim lastRow As Long, SplitStartRow As Long, SplitEndRow As Long
    Dim CopyRange As Range ', MyArray As Range
    Dim folderPath As String, fileName As String
    Dim Iteration As Single
    Dim CustCount As Double, MaxCust As Double
    Dim StopLoop As Boolean
      
    '~~> This portion copies the contents of the CSV onto the "Import" tab
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    ThisWorkbook.Sheets("Export").Cells.Clear
    ThisWorkbook.Sheets("Import").Cells.Clear
    Range("A1").Select
    folderPath = Application.ThisWorkbook.Path & "\"
    Workbooks.Open fileName:= _
        folderPath & "TEST Billing Import.csv"      '<------------------name of raw csv - static value
    Cells.Select
    Selection.Copy
    ThisWorkbook.Activate
    Sheets("Import").Select
    Cells.Select
    ActiveSheet.Paste
    Range("A1").Select
  
    '~~> This portion copies the formatted data to the 'Export' tab
    Iteration = 1
    CustCount = 100
    SplitStartRow = 1
    StopLoop = False
    Dim StartRange As Range
    Set StartRange = Worksheets("Modification").Range("A1")
        Do
        With Sheets("Modification")
            lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
            'Obtains the value from H1 with is the Largest Integer in Customer Count field for loop stopping purposes
            MaxCust = .Range("H1").Value
            'This portion looks for the last instance of the 'CustCount' variable in column F of the 'Modification' tab and returns the row number
            SplitEndRow = .Range("F:F").Find(what:=CustCount, after:=.Range("F1"), searchdirection:=xlPrevious, LookIn:=xlValues, LookAt:=xlWhole).Row
            
            'This is a temp step that confirms the SplitEndRow computation is working
            MsgBox "The variable is " & SplitEndRow
            
            Set CopyRange = .Range(.Cells(SplitStartRow, 1), .Cells(SplitEndRow, 5))
                If Not CopyRange Is Nothing Then
                CopyRange.Copy Sheets("Export").Range("A1")
                End If
        End With
    
    '~~> This portion spins off that range of records into a new file with an iteration suffix in the file name
    folderPath = Application.ThisWorkbook.Path & "\"
    fileName = "QBImport_" & Iteration
    
    ThisWorkbook.Sheets("Export").Copy
    ActiveWorkbook.SaveAs fileName:=folderPath & fileName & ".csv", FileFormat:=xlCSV
    ActiveWorkbook.Close
   
    ThisWorkbook.Sheets("Export").Cells.Clear    '<---------clears contents of export sheets for next run through
            
    SplitStartRow = SplitEndRow + 1  '<----moves the goalposts of the SplitStartRow
    
    'Logic to test to see if this iteration is when we should exit the loop.  If MaxCust = CustCount already, then this is the final loop
    If MaxCust = CustCount Then
    StopLoop = True
    End If
    
    'Logic to increase the CustCount by 100 OR to the MaxCust count if there are fewer than 100 customers left
    If MaxCust < CustCount + 100 Then
    CustCount = MaxCust
    Else
    CustCount = CustCount + 100
    End If
    
    'Logic to increase iteration by 1 in the exported file name
    Iteration = Iteration + 1
    
    'Loop Exit
    Loop While StopLoop <> True
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "Done"
End Sub
 

Some videos you may like

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple

mikestorm

New Member
Joined
Feb 3, 2021
Messages
9
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I just realized there might be come code fragments from prior unsuccessful attempts (StartRange Variable, MyArray variable). Please ignore. I can't seem to edit my original post.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,654
Office Version
  1. 365
Platform
  1. Windows
Hi & welcome to the MrExcel.
Normally when I get stuck I post on Reddit, and I almost always find a path forward, but not so this time so I decided to post here.
In that case can you please supply a link to that thread.

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!
 

mikestorm

New Member
Joined
Feb 3, 2021
Messages
9
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hi & welcome to the MrExcel.

In that case can you please supply a link to that thread.

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

I apologize. I didn't know. Here is the link:
https://www.reddit.com/r/vba/comments/lav6hh
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,654
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Thanks for that, how about
VBA Code:
Sub FileSplitter()

    'Varabiles
    Dim StartNum As Long, MaxCust As Long
    Dim CopyRange As Range ', MyArray As Range
    Dim folderPath As String, fileName As String
    Dim Iteration As Single
    Dim CustCount As Double, MaxCust As Double
    Dim StopLoop As Boolean
      
    '~~> This portion copies the contents of the CSV onto the "Import" tab
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    ThisWorkbook.Sheets("Export").Cells.Clear
    ThisWorkbook.Sheets("Import").Cells.Clear
    Range("A1").Select
    folderPath = Application.ThisWorkbook.Path & "\"
    Workbooks.Open fileName:= _
        folderPath & "TEST Billing Import.csv"      '<------------------name of raw csv - static value
    Cells.Select
    Selection.Copy
    ThisWorkbook.Activate
    Sheets("Import").Select
    Cells.Select
    ActiveSheet.Paste
    Range("A1").Select
  
    '~~> This portion copies the formatted data to the 'Export' tab
   With Sheets("modification")
      MaxCust = .Range("H1").Value
      
      For i = 0 To MaxCust Step 100
         .Range("A1:f1").AutoFilter 6, ">=" & i + 1, xlAnd, "<=" & i + 100
         .AutoFilter.Range.Columns("A:E").Copy Sheets("Export").Range("A1")
    
          '~~> This portion spins off that range of records into a new file with an iteration suffix in the file name
          folderPath = Application.ThisWorkbook.Path & "\"
          fileName = "QBImport_" & Iteration
          
          ThisWorkbook.Sheets("Export").Copy
          ActiveWorkbook.SaveAs fileName:=folderPath & fileName & ".csv", FileFormat:=xlCSV
          ActiveWorkbook.Close
         
          ThisWorkbook.Sheets("Export").Cells.Clear    '<---------clears contents of export sheets for next run through
      Next i
   End With

    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "Done"
End Sub
 
Solution

mikestorm

New Member
Joined
Feb 3, 2021
Messages
9
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Thanks for that, how about
VBA Code:
Sub FileSplitter()

    'Varabiles
    Dim StartNum As Long, MaxCust As Long
    Dim CopyRange As Range ', MyArray As Range
    Dim folderPath As String, fileName As String
    Dim Iteration As Single
    Dim CustCount As Double,[S] [B]MaxCust As Double[/B][/S]
    Dim StopLoop As Boolean
    
    '~~> This portion copies the contents of the CSV onto the "Import" tab
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
  
    ThisWorkbook.Sheets("Export").Cells.Clear
    ThisWorkbook.Sheets("Import").Cells.Clear
    Range("A1").Select
    folderPath = Application.ThisWorkbook.Path & "\"
    Workbooks.Open fileName:= _
        folderPath & "TEST Billing Import.csv"      '<------------------name of raw csv - static value
    Cells.Select
    Selection.Copy
    ThisWorkbook.Activate
    Sheets("Import").Select
    Cells.Select
    ActiveSheet.Paste
    Range("A1").Select
[/QUOTE]
   '~~> This portion copies the formatted data to the 'Export' tab
[QUOTE="Fluff, post: 5631913, member: 289073"]
   With Sheets("modification")
      MaxCust = .Range("H1").Value
    
      For i = 0 To MaxCust Step 100
         .Range("A1:f1").AutoFilter 6, ">=" & i + 1, xlAnd, "<=" & i + 100
         .AutoFilter.Range.Columns("A:E").Copy Sheets("Export").Range("A1")
  
          '~~> This portion spins off that range of records into a new file with an iteration suffix in the file name
          folderPath = Application.ThisWorkbook.Path & "\"
          fileName = "QBImport_" & Iteration
        
          ThisWorkbook.Sheets("Export").Copy
          ActiveWorkbook.SaveAs fileName:=folderPath & fileName & ".csv", FileFormat:=xlCSV
          ActiveWorkbook.Close
       
          ThisWorkbook.Sheets("Export").Cells.Clear    '<---------clears contents of export sheets for next run through
      Next i
   End With

  
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "Done"
End Sub
 

mikestorm

New Member
Joined
Feb 3, 2021
Messages
9
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Thank you! MaxCust was declared twice, so I had to delete once, and I had to bring back my iteration variable and increment it with each loop because the output saved over itself seven times as QBImport_0.csv but as it literally took you a minute to cobble together, I'm amazed. It worked perfectly!
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,654
Office Version
  1. 365
Platform
  1. Windows
Glad to help & thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,808
Messages
5,627,010
Members
416,214
Latest member
boston814

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top