Dynamic Range

[hemanthkb]

How do i make the range which is copying from the below code to dynamic.

The below code is specific to one application and which is restricted to specific range "A19:v", for different applications it varies how to make it dynamic for different applications.

tried different methods, subscript out of range error is appearing.

here is the code, please help.

Sub Consolidate()

Dim fName As String, fPath As String, fPathDone As String
Dim LR As Long, NR As Long, LR1 As Long, lastRow02 As Long, spath As String, sDate As String
Dim flag As Boolean
Dim i As Integer

Dim wbData As Workbook, wsMaster As Worksheet, Wb2 As Workbook



Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
flag = True

spath = Application.GetOpenFilename("Exel Files (*.xlsx), *.xlsx", , "Please select Master FIle", False)

'Set Wb2 = Workbooks.Open("\\svrin000mbp01.asia.corp.anz.com\balajih1$\My Documents\Hemanth\DBA team\Pavan\MasterFile.xlsx")
Set Wb2 = Workbooks.Open(spath)
'Path for output file

Set wsMaster = Wb2.Sheets("Sheet1")


With wsMaster

If MsgBox("Clear the old data first?", vbYesNo) = vbYes Then
.UsedRange.Offset(1).EntireRow.Clear
NR = 2
Else
NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1

End If

'fPath = "\\svrin000mbp01.asia.corp.anz.com\balajih1$\My Documents\Hemanth\DBA team\Pavan\Attachments\Attachments1" 'Path for imported files folder

'MsgBox "Please select a folder with files to consolidate"
Do
With Application.FileDialog(msoFileDialogFolderPicker)

.InitialFileName = "\\svrin000mbp01.asia.corp.anz.com\balajih1$\My Documents\Hemanth\DBA team\Pavan\Attachments\Attachments1"
.AllowMultiSelect = False
.Title = "Browse a folder with files to consolidate"
.Show
If .SelectedItems.Count > 0 Then
fPath = .SelectedItems(1) & ""

Exit Do
Else
If MsgBox("No folder chose, do you wish to abort?", _
vbYesNo) = vbYes Then Exit Sub
End If
End With
Loop
fPathDone = fPath & "Imported"
On Error Resume Next
MkDir fPathDone
On Error GoTo 0
fName = Dir(fPath & "*.xlsm")


Do While Len(fName) > 0
If fName <> ThisWorkbook.Name Then
Set wbData = Workbooks.Open(fPath & fName)

'--------- Added new------
flag = True
LR = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
If (LR <= 18) Then
flag = False
wbData.Close False
End If


For i = 19 To LR
If (ActiveSheet.Range("A" & i).Value = "Select your Decision") Then
flag = False
wbData.Close False
Exit For
End If
Next



If (flag = True) Then
'---------------new Ended-----
LR = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

sDate = Replace(Split(Mid(fName, InStr(1, fName, "_") + 1, 21), " ")(0), "_", "/") & " " & Replace(Split(Mid(Replace(fName, ".xlsm", ""), InStr(1, fName, "_") + 1), " ")(1), "_", ":") & " " & Replace(Split(Mid(Replace(fName, ".xlsm", ""), InStr(1, fName, "_") + 1), " ")(2), "_", ":")

LR = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
ActiveSheet.Range("A19:V" & LR).EntireRow.Copy
Workbooks("MasterFile.xlsx").Activate
Sheets("Sheet1").Select
NR = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets("Sheet1").Range("A" & NR).Select
ActiveSheet.Paste
wbData.Close False
lastRow02 = ActiveSheet.Range("A" & .Rows.Count).End(xlUp).Row
'ActiveSheet.Range("W" & NR & ":W" & lastRow02).Value = Format(VBA.CStr(sDate), "dd/mm/yyyy hh:mm:ss AM/PM")
'ActiveSheet.Range("W" & NR & ":W" & lastRow02).Value = Trim(sDate)
ActiveSheet.Range("W" & NR & ":W" & lastRow02).Value = Format(VBA.CStr(sDate), "mm/dd/yyyy hh:mm:ss AM/PM")


NR = ActiveSheet.Range("A" & .Rows.Count).End(xlUp).Row + 1

Name fPath & fName As fPathDone & fName
End If

End If


fName = Dir
Loop

End With

ErrorExit:

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

Please help

 

[JLGWhiz]

[COLOR=#0000cd][B]LR = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
[/B][/COLOR][B][COLOR=#0000cd]    ActiveSheet.Range("A19:V" & LR).EntireRow.Copy[/COLOR][/B]

These two lines make the range vertically dynamic with respect to column A, Except that it cannot expand upward to rows 1:18. In what respect did you want it to fluctuate?