Looping VBA not working correctly

AggyRJ

New Member
Joined
Mar 29, 2013
Messages
16
I am creating a tool which takes data from worksheets which are stored on a server and pastes them into a single sheet together so that I can work with the data. The issue I am having is a result of the fact that each worksheet comes from a different store and there is no identifier within the worksheet itself that says that. So I created a list of store numbers on a different page and am using StoreNumber = ActiveCell.Value to store the number to work with.

Once the worksheet is grabbed and pasted into the sheet I want it, I have the macro set so that it goes to the first open column (AF), finds the first empty cell, pastes in StoreNumber, and then fills down. In order to know how many rows to fill down, once it finds the empty row in AF it moves over to column A and uses Range(Selection, Selection.End(xlDown)).Select and RowCount = Selection.Count to store the number of rows to fill down. Then it goes back to the first empty cell in AF and uses ActiveCell.AutoFill Range(ActiveCell.Address, Cells(RowCount, ActiveCell.Column)) to fill down.

This works fine for the first store, and the loop then goes back to the store number list, moves down one and stores the new store number that is there. Then it loops back around and gets the new info and pastes it in the correct place. My issue is when it follows the same steps it doesn't paste and fill the store number correctly, as if Excel doesn't know where to start or how far to fill down. It still pastes in column AF, but where it starts and how far is fills down doesn't make any sense. What am I doing wrong? I will paste the code below, and I truly appreciate any help as this has been bothering me for days now.

Code:
Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    'Set default parameters
    Sheets("Stores").Select
    Report_Path = Range("Report_Path").Value
    DateForReport = Range("Formatted_Date").Value
    Report_Date_Test = Range("Report_Date").Value
    ReportName = Range("Report_Name").Value
    CurrentWorkbook = ActiveWorkbook.Name
    ReportWorkbook = ReportName & "_" & DateForReport & ".xlsm"
        
    Range("K2").Select
    StoreNo = ActiveCell.Value
    
    Do While ActiveCell.Value <> 0
    
    'Open the Report file
    Workbooks.Open Report_Path & "" & StoreNo & "" & ReportWorkbook
        
    'Copy Data
    Workbooks(ReportWorkbook).Activate
     
    Sheets("Data").Select
    Range("A2:BZ20000").Select
    Selection.Copy
        
    'Paste Data
    Workbooks(CurrentWorkbook).Activate
    Sheets("Working").Select
    Range("A2").Select
    
    If ActiveCell = "" Then
    
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    Else
        Selection.End(xlDown).Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    End If
    
    Range("AF2").Select
        If ActiveCell = "" Then
            Selection.End(xlToLeft).Select
            Selection.End(xlToLeft).Select
            Selection.End(xlToLeft).Select
            Selection.End(xlToLeft).Select
            Range(Selection, Selection.End(xlDown)).Select
            Application.CutCopyMode = False
            RowCount = Selection.Count
            Range("AF2").Select
                ActiveCell.Value = StoreNo
                ActiveCell.AutoFill Range(ActiveCell.Address, Cells(RowCount, ActiveCell.Column))
                Selection.End(xlDown).Offset(1, 0).Select
                ActiveCell.Value = StoreNo
        
    
        Else
            Selection.End(xlDown).Offset(1, 0).Select
            Selection.End(xlToLeft).Select
            Selection.End(xlToLeft).Select
            Selection.End(xlToLeft).Select
            Selection.End(xlToLeft).Select
            Range(Selection, Selection.End(xlDown)).Select
            Application.CutCopyMode = False
            RowCount = Selection.Count
            Range("AF2").Select
            Selection.End(xlDown).Offset(1, 0).Select
            ActiveCell.Value = StoreNo
            
            ActiveCell.AutoFill Range(ActiveCell.Address, Cells(RowCount, ActiveCell.Column))
            Range("AF2").Select
            Selection.End(xlDown).Offset(1, 0).Select
            ActiveCell.Value = StoreNo
       End If
    
    'Close Report file
    Workbooks(ReportWorkbook).Close
                                 
    Sheets("Stores").Select
    
    ActiveCell.Offset(1, 0).Select
    StoreNo = ActiveCell.Value
    
    Loop
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
 
Last edited by a moderator:

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Untested but try
Code:
   Dim currentWbk As Workbook
   Dim Cl As Range
   Dim Rng As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    
    'Set default parameters
   Sheets("Stores").Select
   Report_Path = Range("Report_Path").Value
   DateForReport = Range("Formatted_Date").Value
   Report_Date_Test = Range("Report_Date").Value
   ReportName = Range("Report_Name").Value
   Set CurrentWbkk = ActiveWorkbook
   ReportWorkbook = ReportName & "_" & DateForReport & ".xlsm"
   
   For Each Cl In Range("K2", Range("K" & Rows.Count).End(xlUp))
      
      'Open the Report file
      Workbooks.Open Report_Path & "" & Cl.Value & "" & ReportWorkbook
      
      'Copy Data
      With Workbooks(ReportWorkbook).Sheets("Data")
         Set Rng = .Range("A2:BZ" & Range("A" & Rows.Count).End(xlUp).Row)
         Rng.Copy
      End With
      'Paste Data
      Workbooks(CurrentWorkbook).Activate
      With Sheets("Working").Range("A" & Rows.Count).End(xlUp).Offset(1)
         .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
         .Offset(, 31).Resize(Rng.Rows) = Cl.Value
      End With
      
      'Close Report file
      Workbooks(ReportWorkbook).Close
   Next Cl
   
   Application.DisplayAlerts = True
   Application.ScreenUpdating = True
 
Upvote 0
sound like you need four row identifiers, your main book, refreshed each time you open a new reference file, then other references to work out where to start and finish. you should implicitly identify your workbooks so they are referenced correctly each change
 
Upvote 0

Forum statistics

Threads
1,223,905
Messages
6,175,297
Members
452,633
Latest member
DougMo

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
Back
Top