Loop through a dynamic range.

Add a variable to determine the last row, ie:

Dim lr as long
lr = range("A" & rows.count).end(xlup).row

then substitute the variable lr for the last row, ie:

Range("A2:U" & lr)

it would be very helpful in understanding what you are attempting to do if you post a sample worksheet and explain what you wish to happen versus trying to understand what you want in your code with the current explanation.

I think this is what you mean:

Start in row 2
Do Until cells in columns A-U are blank
   Perform an action
   Go to next row
Loop

This code should do that but I haven't tested it. It's not practical to build a test file from scratch, plus this is only part of your code and I don't know what else you have. If you attach your file I would be happy to test it.

  
             Dim Rg As Range 
             Dim R As Long ' Row          
             Do While Len(FileName) > 0
                Set wbk = Workbooks.Open(Path & FileName, UpdateLinks:=0)
                
                'Extract workbook name to Column "X", (adjacent to its value from "R19" or "P19", in Column "W" (see below))
                wbdest.Worksheets("Sheet1").Range("X" & Rows.count).End(xlUp).Offset(1) = wbk.Name
           
                    wbdest.Worksheets("Sheet1").Range("Y" & Rows.count).End(xlUp).Offset(1).Formula = "=MID(RC[-1],FIND(""ABC"",RC[-1])+3,6)"
                   
                        R = 2
                        Set Rg = Range(Cells(R, "A"), Cells(R, "U"))
                        Do Until Join(Application.Index(Rg.Value, 1, 0)) = ""
                           If wbdest.Worksheets("Sheet1").Range("Y" & Rows.count).End(xlUp) < 160813 Then
                       
                               wbk.Sheets(1).Range("B39:S39") = wbdest.Worksheets("Sheet1").Rg.Value
                               wbdest.Worksheets("Sheet1").Range("W" & Rows.count).End(xlUp).Offset(1) = wbk.Sheets(1).Range("R19")
                           Else
                               wbk.Sheets(1).Range("B39:S39") = wbdest.Worksheets("Sheet1").Rg.Value
                               wbdest.Worksheets("Sheet1").Range("W" & Rows.count).End(xlUp).Offset(1) = wbk.Sheets(1).Range("P19")
                           End If
                           R = R + 1
                           Set Rg = Range(Cells(R, "A"), Cells(R, "U"))
                       Loop
                
                wbk.Close SaveChanges:=False
                FileName = Dir
            Loop
    
        With Range("W2", Cells(Rows.count, "W").End(xlUp))
        'Chose what to delete before calc. average
            .Cells.Find(Application.Max(.Cells), lookat:=xlWhole).ClearContents
            '.Cells.Find(Application.Max(.Cells), lookat:=xlWhole).ClearContents
            '.Cells.Find(Application.Max(.Cells), lookat:=xlWhole).ClearContents
            '.Cells.Find(Application.Min(.Cells), lookat:=xlWhole).ClearContents
            '.Cells.Find(Application.Min(.Cells), lookat:=xlWhole).ClearContents
            
            .Cells(.Cells.count).Offset(1, 0) = "=Average(" & .Cells.Address & ")"
        End With

    'Copy last row from "W" to "V", adjacent to Range("A2:U2") etc. (Not sure this works).
    ActiveSheet.Range("V" & Rows.Count).End(xlUp).Offset(1) = ActiveSheet.Range("W" & Rows.Count).End(xlUp)

Originally Posted by Sluggoslabang

wbk.Sheets(1).Range("B39:V39") = wbdest.Worksheets("Sheet1").Rg.Value

I think this should be

wbk.Sheets(1).Range("B39:V39").Value = wbdest.Worksheets("Sheet1").Rg.Value

I can't offer anything else unless you attach your file, as suggested very wisely by alansidman.

Attach a sample workbook. Make sure there is just enough data to demonstrate your need. Include a BEFORE sheet and an AFTER sheet in the workbook if needed to show the process you're trying to complete or automate. Make sure your desired results are shown, mock them up manually if necessary.

Remember to desensitize the data.

Click on GO ADVANCED and then scroll down to Manage Attachments to open the upload window.

Hi,

Rg is a variable and therefore not a property of a worksheet. Either you must use:

wbk.Sheets(1).Range("B39:V39").Value = Rg.Value

or something akin to this

wbk.Sheets(1).Range("B39:V39").Value = wbdest.Worksheets("Sheet1").Range(Rg.Address).Value

However from my brief perusal of the code I am not certain that Rg is being set using the correct worksheet.

Both of the Rg assignments should be changed from

Set Rg = Range(Cells(R, "A"), Cells(R, "U"))

to read

Set Rg = wbdest.Worksheets("Sheet1").Range(wbdest.Worksheets("Sheet1").Cells(R, "A"), wbdest.Worksheets("Sheet1").Cells(R, "U"))

or more simply

Set Rg = wbdest.Worksheets("Sheet1").Cells(R, "A").Resize(1, 21)

I'm afraid I do not follow what you are saying. Can you please post the full code that you have now and state clearly what is happening, as well as what should be happening?

Hi xlnitwit,
Ok, here is another explanation:
In Workbook "viktutv.xls(m)", (as you can download from this thread) you find the "ranges" I am talking about.
You find them in "viktutv.xls(m)", and they are:
First range is: Column "A" Row 2 to Column "U" Row 2, ("A2:U2").
Second range is: Column "A" Row 3 to Column "U" Row 3, ("A3:U3").
Last range is: last row with numbers in any cell, in column "A" to "U".
In this example, row 14 is the last row, but must be dynamic in the code.

In my "Test3" folder, I have many workbooks (*.xlsm).

My code paste first range ("A2:U2") from "viktutv.xlsm", in first workbook in folder "Test3", in cells ("B39:V39").
Extracts filename from first workbook in folder "Test3", extracts date from that filename.
Then copying Cell R19 or P19 in first workbook in folder "Test3", and paste that value in column "W" in "viktutv.xls(m)", adjacent to its filename in column "X".
Then code loop and do exactly the same with second workbook in folder "Test3",
and so on, until the last workbook in folder "Test3".
After deleting the highest value in column "W" in "viktutv.xlsm", my code calculates the average (of those values) and copy that value to cell "V2", adjacent to its range ("A2:U2").

So far my code is working good.

Here comes my problem:
(I think we need another loop here for the ranges)
Now I want the code to change from first range in "viktutv.xls(m)", to second range in "viktutv.xls(m)", and start from beginning again with first workbook in folder "Test3" (see above), and so on until all workbooks in folder "Test3", are processed with the second range.
After that, paste the new average, adjacent to its range ("A3:U3").

And so on, until the last range in "viktutv.xls(m)" is processed on all workbooks in folder "Test3".

I hope this made everything crystal clear (joking)

Here is my original code:

Sub AllinTest3Folder()
'Sent to ExcelForum
Dim FileName As String, Path As String
Dim wbk As Workbook, wbdest As Workbook
Dim ws As Worksheet
Dim lRow As Long
Dim StartCell As Range

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    .EnableEvents = False
End With

Path = "C:\Station\Div\GTA\Test\Test3\"
FileName = Dir(Path & "*.xlsm")

Set wbdest = Workbooks.Open("C:\Station\Div\GTA\viktutv.xlsm")

Set StartCell = Range("W2")
Set ws = ActiveSheet
    lRow = ws.Cells(ws.Rows.count, StartCell.Column).End(xlUp).Row
    ws.Range(StartCell, ws.Cells(lRow, "Y")).ClearContents

        Do While Len(FileName) > 0
            Set wbk = Workbooks.Open(Path & FileName, UpdateLinks:=0)
                
                'Extract workbook name to Column "X", (adjacent to its value from "R19" or "P19", in Column "W" (see below))
                wbdest.Worksheets("Sheet1").Range("X" & Rows.count).End(xlUp).Offset(1) = wbk.Name
           
                    'Extract 'date'-numbers from filename
                    wbdest.Worksheets("Sheet1").Range("Y" & Rows.count).End(xlUp).Offset(1).Formula = "=MID(RC[-1],FIND(""ABC"",RC[-1])+3,6)"
                   
                        'If date is older than 160813, Then
                        If wbdest.Worksheets("Sheet1").Range("Y" & Rows.count).End(xlUp) < 160813 Then
                       
                            wbk.Sheets(1).Range("B39:V39") = wbdest.Worksheets("Sheet1").Range("A2:U2").Value
                            wbdest.Worksheets("Sheet1").Range("W" & Rows.count).End(xlUp).Offset(1) = wbk.Sheets(1).Range("R19")
                        Else
                            wbk.Sheets(1).Range("B39:V39") = wbdest.Worksheets("Sheet1").Range("A2:U2").Value
                            wbdest.Worksheets("Sheet1").Range("W" & Rows.count).End(xlUp).Offset(1) = wbk.Sheets(1).Range("P19")
                        End If
                
            wbk.Close SaveChanges:=False
            FileName = Dir
        Loop
    
With Range("W2", Cells(Rows.count, "W").End(xlUp))
'Chose what to delete before calc. average
    .Cells.Find(Application.Max(.Cells), lookat:=xlWhole).ClearContents
    'Cells.Find(Application.Max(.Cells), lookat:=xlWhole).ClearContents
    '.Cells.Find(Application.Max(.Cells), lookat:=xlWhole).ClearContents
    '.Cells.Find(Application.Min(.Cells), lookat:=xlWhole).ClearContents
    'Cells.Find(Application.Min(.Cells), lookat:=xlWhole).ClearContents
            
    .Cells(.Cells.count).Offset(1, 0) = "=Average(" & .Cells.Address & ")"
End With
    
    'Copy last row from "W" to "V", adjacent to Range("A2:U2") etc.etc.
    ActiveSheet.Range("V" & Rows.count).End(xlUp).Offset(1) = ActiveSheet.Range("W" & Rows.count).End(xlUp)
    
With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
    .EnableEvents = True
End With

End Sub

Given that the original code does what is required, we can in theory simply add another loop like so

Sub AllinTest3Folder()
'Sent to ExcelForum
    Dim FileName As String, Path As String
    Dim wbk As Workbook, wbdest As Workbook
    Dim ws                    As Worksheet
    Dim lastRow               As Long
    Dim rowNum                As Long
    Dim StartCell             As Range

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
    End With

    Path = "C:\Station\Div\GTA\Test\Test3\"

    Set wbdest = Workbooks.Open("C:\Station\Div\GTA\viktutv.xlsm")
    Set ws = ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, "W").End(xlUp).Row

    ws.Range("W2:Y" & lastRow).ClearContents
    
    For rowNum = 2 To lastRow
        FileName = Dir(Path & "*.xlsm")
        Do While Len(FileName) > 0
            Set wbk = Workbooks.Open(Path & FileName, UpdateLinks:=0)
            'Extract workbook name to Column "X", (adjacent to its value from "R19" or "P19", in Column "W" (see below))
            wbdest.Worksheets("Sheet1").Range("X" & Rows.Count).End(xlUp).offset(1) = wbk.Name

            'Extract 'date'-numbers from filename
            wbdest.Worksheets("Sheet1").Range("Y" & Rows.Count).End(xlUp).offset(1).Formula = "=MID(RC[-1],FIND(""ABC"",RC[-1])+3,6)"

            'If date is older than 160813, Then
            If wbdest.Worksheets("Sheet1").Range("Y" & Rows.Count).End(xlUp) < 160813 Then

                wbk.Sheets(1).Range("B39:V39") = wbdest.Worksheets("Sheet1").Cells(rowNum, "A").Resize(1, 21).Value
                wbdest.Worksheets("Sheet1").Range("W" & Rows.Count).End(xlUp).offset(1) = wbk.Sheets(1).Range("R19")
            Else
                wbk.Sheets(1).Range("B39:V39") = wbdest.Worksheets("Sheet1").Cells(rowNum, "A").Resize(1, 21).Value
                wbdest.Worksheets("Sheet1").Range("W" & Rows.Count).End(xlUp).offset(1) = wbk.Sheets(1).Range("P19")
            End If

            wbk.Close SaveChanges:=False
            FileName = Dir
        Loop
    Next rowNum
    
    With Range("W2", Cells(Rows.Count, "W").End(xlUp))
        'Chose what to delete before calc. average
        .Cells.Find(Application.Max(.Cells), lookat:=xlWhole).ClearContents
        'Cells.Find(Application.Max(.Cells), lookat:=xlWhole).ClearContents
        '.Cells.Find(Application.Max(.Cells), lookat:=xlWhole).ClearContents
        '.Cells.Find(Application.Min(.Cells), lookat:=xlWhole).ClearContents
        'Cells.Find(Application.Min(.Cells), lookat:=xlWhole).ClearContents

        .Cells(.Cells.Count).offset(1, 0) = "=Average(" & .Cells.address & ")"
    End With

    'Copy last row from "W" to "V", adjacent to Range("A2:U2") etc.etc.
    ActiveSheet.Range("V" & Rows.Count).End(xlUp).offset(1) = ActiveSheet.Range("W" & Rows.Count).End(xlUp)

    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With

End Sub

This is extremely inefficient since you are opening and closing workbooks repeatedly but I fear I do not currently have sufficient time to refactor the code.