Set value for range being copied over with VBA

[ItalianPlatinum]

May someone help me I think I am inherently doing something incorrectly. I just want to copy "NonF" down for each file that is transferred over as well as the file name that it came from. But what I have isn't doing that. It is just putting it on the last row.

Sub Summary()
Dim fName As String, fPath As String, fPartial As String
Dim WsNonF As Worksheet, WsSummary As Worksheet
Dim NrNonF As Long, NrFOF As Long
Dim lastrow As Long, lr As Long, lrr As Long
Dim WbkName As String

Application.ScreenUpdating = False

'set sheet variables
Set WsNonF = Sheets("NONFDATA")
Set WsSummary = Sheets("Summary")

WsNonF.Cells.Delete
WsSummary.Cells.ClearContents

'Non F
fPath = "MY PATH" 'substitute actual path is not in same directory as host workbook.
fPartial = "PARTIAL FINAL NAME" & Year(Now) & IIf(Len(Month(Now)) = 1, "0" & Month(Now), Month(Now)) & IIf(Len(Day(Now) - 1) = 1, "0" & Day(Now) - 1, Day(Now) - 1) & "*.txt"

If Right(fPath, 1) <> "\" Then fPath = fPath & "\"
fName = Dir(fPath & fPartial)
    Do While fName <> "" 'open each file loop until no more files to open
        Workbooks.OpenText fPath & fName 'opening the txt file
        NrNonF = WsNonF.Range("A" & Rows.Count).End(xlUp).Row + 1 'find open row
        lastrow = Cells(Rows.Count, "A").End(xlUp).Row - 1 'find the maximum row
        WbkName = Left(ActiveWorkbook.Name, InStr(ActiveWorkbook.Name, ".") - 1) 'get activeworkbooks name
        Range("A2:A" & lastrow).Copy 'Copy data
        WsNonF.Range("A" & NrNonF).PasteSpecial Paste:=xlPasteValues 'paste to next open row
        lrr = WsNonF.Cells(Rows.Count, "A").End(xlUp).Row 'find the range that came over from the file
        WsNonF.Range("L" & lrr).Value = "NonF" 'set the type of file it came from
        WsNonF.Range("M" & lrr).Value = WbkName 'set the file name it came from
        Application.CutCopyMode = False
        Workbooks(fName).Close SaveChanges:=False 'close file dont save
        fName = Dir
    Loop

 

[Alex Blakenburg]

The way it looks to me you have the starting row in NrNonF and the ending row with lrr, so any one of the 3 options below should work (and there are many more ways you could do it).

A couple of suggestions:
• consider renaming lrr so you now which worksheet it relates to
• You are relying on the ActiveWorkbook / Worksheet for lines such "Cells(Rows.Count, "A").End(xlUp).Row - 1" & "Range("A2:A" & lastrow).Copy 'Copy data", it would be better to explicitly reference the workbook / worksheet you are using, by setting a reference and using that reference or using a with statement and using .Cells and .Range

        ' Alternative 1
        WsNonF.Range("L" & NrNonF & ":L" & lrr).Value = "NonF"      'set the type of file it came from
        WsNonF.Range("M" & NrNonF & ":M" & lrr).Value = WbkName     'set the file name it came from
        
        ' Alternative 2
        With WsNonF
            .Range(.Cells(NrNonF, "L"), .Cells(lrr, "L")).Value = "NonF"    'set the type of file it came from
            .Range(.Cells(NrNonF, "M"), .Cells(lrr, "M")).Value = WbkName   'set the file name it came from
        End With
        
        ' Alternative 3
        With WsNonF.Range(.Cells(NrNonF, "L"), .Cells(lrr, "L"))
            .Value = "NonF"                                 'set the type of file it came from
            .Offset(, 1).Value = WbkName                    'set the file name it came from
        End With

 

[ItalianPlatinum]

I will give 1 of the options you provided above and report back how it worked.

To answer your question about the active workbook. I open the workbook using partial parameters so I had trouble trying to reference it. But I needed a way to still record the file name so on my data so I know which file it came from. The best I came up with was that approach I am sure there must be a better more efficient way? What would you recommend?

Thanks for looking as always Alex.

 

[ItalianPlatinum]

Alright so I seem to be running into an issue with option 2 (mostly likely a me issue). The first dataset is 144 records so that works. The second data set coming over is 89. So when the second loop comes it places it starting on row 89. when it should be row 145 for 89 times. So then my next subsequent runs come along incorrectly as well.

If Right(fPath, 1) <> "\" Then fPath = fPath & "\"
fName = Dir(fPath & fPartial)
    Do While fName <> "" 'open each file loop until no more files to open
        Workbooks.OpenText fPath & fName 'opening the txt file
        NrNonF = WsNonF.Range("A" & Rows.Count).End(xlUp).Row + 1 'find open row on destination worksheet
        WbkName = Left(ActiveWorkbook.Name, InStr(ActiveWorkbook.Name, ".") - 1) 'get activeworkbooks name
        lastrow = Cells(Rows.Count, "A").End(xlUp).Row - 1 'find the maximum row on the source worksheet
        lrr = Cells(Rows.Count, "A").End(xlUp).Row - 1 'find the range in use to apply the type of file and file name
        Range("A2:A" & lastrow).Copy 'Copy data from .txt file
        With WsNonF
            .Range("A" & NrNonF).PasteSpecial Paste:=xlPasteValues 'paste to next open row
            .Range(.Cells(NrNonF, "L"), .Cells(lrr, "L")).Value = "NonF"    'set the type of file it came from
            .Range(.Cells(NrNonF, "M"), .Cells(lrr, "M")).Value = WbkName   'set the file name it came from
            .Application.CutCopyMode = False
        End With
        Workbooks(fName).Close SaveChanges:=False 'close file dont save
        fName = Dir
    Loop

 

[Alex Blakenburg]

The main issue is that there seems to have been some confusion and you have moved and changed the "lrr =" line.
See if this works for you.
(My Dim lrrNonF would replace your Dim lrr line)
Also you appear to be dropping the header and footer of your text file. I assume this is intentional.

Dim wbImport As Workbook, wsImport As Worksheet
Dim lrrNonF As Long                                                             'XXX This was just lrr XXX

If Right(fPath, 1) <> "\" Then fPath = fPath & "\"
fName = Dir(fPath & fPartial)
    Do While fName <> ""                                                        'open each file loop until no more files to open
            
        Workbooks.OpenText fPath & fName 'opening the txt file
        Set wbImport = ActiveWorkbook
        Set wsImport = wbImport.Worksheets(1)
        
        NrNonF = WsNonF.Range("A" & Rows.Count).End(xlUp).Row + 1               'find open row on destination worksheet
        
        With wbImport
            WbkName = Left(.Name, InStr(.Name, ".") - 1)                        'get activeworkbooks name
        End With
        
        With wsImport
            lastrow = .Cells(Rows.Count, "A").End(xlUp).Row - 1                 'find the maximum row on the source worksheet
            .Range("A2:A" & lastrow).Copy                                       'Copy data from .txt file
        End With
        
        With WsNonF
            .Range("A" & NrNonF).PasteSpecial Paste:=xlPasteValues              'paste to next open row
            lrrNonF = .Cells(Rows.Count, "A").End(xlUp).Row                     'find the range that came over from the file
            .Range(.Cells(NrNonF, "L"), .Cells(lrrNonF, "L")).Value = "NonF"    'set the type of file it came from
            .Range(.Cells(NrNonF, "M"), .Cells(lrrNonF, "M")).Value = WbkName   'set the file name it came from
            .Application.CutCopyMode = False
        End With
        wbImport.Close SaveChanges:=False                                       'close file dont save
        
        fName = Dir
    Loop

 

[ItalianPlatinum]

you are correct the header is the date and the footer is just the number of rows so for my sake of use I don't need it. The code is failing here with run-time error 91 object variable or with block not set

    With wbImport
        WbkName = Left(.Name, InStr(.Name, ".") - 1)
    End With

 

[ItalianPlatinum]

I think its ok though I may have adjusted to get it to work still. see below if you agree.

Is there a better way to remove Copy and paste like I am doing? I notice I am losing speed cause the data and rows are so large?

    Do While fName <> "" 'open each file loop until no more files to open
        Workbooks.OpenText fPath & fName 'opening the txt file
        Set WbImport = ActiveWorkbook
        Set WsImport = WbImport.Worksheets(1)
        WbkName = Left(ActiveWorkbook.Name, InStr(ActiveWorkbook.Name, ".") - 1) 'get activeworkbooks name
   
    With WsImport
        lastrow = .Cells(Rows.Count, "A").End(xlUp).Row - 1 'find the maximum row on the source worksheet
        .Range("A2:A" & lastrow).Copy 'Copy data from .txt file
    End With
   
    With WsNonF
        NrNonF = .Range("A" & Rows.Count).End(xlUp).Row + 1 'find open row on destination worksheet
        .Range("A" & NrNonF).PasteSpecial Paste:=xlPasteValues 'paste to next open row
        LrrNonF = .Cells(Rows.Count, "A").End(xlUp).Row                     'find the range that came over from the file
        .Range(.Cells(NrNonF, "L"), .Cells(LrrNonF, "L")).Value = "NonF"    'set the type of file it came from
        .Range(.Cells(NrNonF, "M"), .Cells(LrrNonF, "M")).Value = WbkName   'set the file name it came from
        .Application.CutCopyMode = False
    End With
        Workbooks(fName).Close SaveChanges:=False 'close file dont save
        fName = Dir
    Loop

 

[Alex Blakenburg]

I am not sure it will make enough of a difference but try commenting out the copy and paste lines in red and add the line in blue.

        With wsImport
            lastrow = .Cells(Rows.Count, "A").End(xlUp).Row - 1                 'find the maximum row on the source worksheet
            '.Range("A2:A" & lastrow).Copy                                       'Copy data from .txt file
        End With
        
        With WsNonF
            '.Range("A" & NrNonF).PasteSpecial Paste:=xlPasteValues              'paste to next open row
            .Range("A" & NrNonF).Resize(lastrow - 1).Value = wsImport.Range("A2:A" & lastrow).Value

 

[ItalianPlatinum]

Yeah I think your right it did slightly, but not that considerably. I am sure my problem is the opening of text files. thanks for the help. I sort of encountered an issue with similar issue further down. I then transfer the data to a summary tab. Did I mess that up too? I was trying to reference the LRF and LRNONF again but do i need to set it again? What am I messing up. Again the initial load works but the items after NRSUM don't. it doesn't stack it below.

With WsSummary
    .Range("A6:J6") = Array("P", "C", "F", "Cl", "N", "ID", "F or Non F", "File ID", "Frequency", "Change")
    .Range("A7:A" & lrNonF).Value = WsNonF.Range("K1:K" & lrNonF).Value 'transfer over ID
    .Range("B7:B" & lrNonF).Value = WsNonF.Range("B1:B" & lrNonF).Value 'transfer over c
    .Range("E7:E" & lrNonF).Value = WsNonF.Range("E1:E" & lrNonF).Value 'transfer over N
    .Range("G7:G" & lrNonF).Value = WsNonF.Range("L1:L" & lrNonF).Value 'transfer over Type of File
    .Range("H7:H" & lrNonF).Value = WsNonF.Range("M1:M" & lrNonF).Value 'transfer over File Name
NrSUM = .Range("A" & Rows.Count).End(xlUp).Row + 1 'find open row
    .Range("A" & NrSUM).Value = WsF.Range("K1:K" & lrf).Value 'transfer over ID
    .Range("B" & NrSUM).Value = WsF.Range("B1:B" & lrf).Value 'transfer over c
    .Range("E" & NrSUM).Value = WsF.Range("E1:E" & lrf).Value 'transfer over N
    .Range("G" & NrSUM).Value = WsF.Range("L1:L" & lrf).Value 'transfer over Type of File
    .Range("H" & NrSUM).Value = WsF.Range("M1:M" & lrf).Value 'transfer over File Name
    .Cells.EntireColumn.AutoFit
    .Range("6:6").AutoFilter
    .Activate
End With

 

[Alex Blakenburg]

When you are doing an assignment ie (.value = .value) the size of the range on either side of the equals sign needs to match.
This is generally easier if you use resize on the left hand side.
Note: in this case I am using resize to the last row value but this only works because the right hand side is starting at row 1 and hence the last row value is effectively the number of rows. Otherwise you would need to adjust for the starting row or do a row count.

With WsSummary
    .Range("A6:J6") = Array("P", "C", "F", "Cl", "N", "ID", "F or Non F", "File ID", "Frequency", "Change")
    .Range("A7").Resize(lrNonF).Value = WsNonF.Range("K1:K" & lrNonF).Value 'transfer over ID
    .Range("B7").Resize(lrNonF).Value = WsNonF.Range("B1:B" & lrNonF).Value 'transfer over c
    .Range("E7").Resize(lrNonF).Value = WsNonF.Range("E1:E" & lrNonF).Value 'transfer over N
    .Range("G7").Resize(lrNonF).Value = WsNonF.Range("L1:L" & lrNonF).Value 'transfer over Type of File
    .Range("H7").Resize(lrNonF).Value = WsNonF.Range("M1:M" & lrNonF).Value 'transfer over File Name
NrSUM = .Range("A" & Rows.Count).End(xlUp).Row + 1 'find open row
    .Range("A" & NrSUM).Resize(lrf).Value = WsF.Range("K1:K" & lrf).Value 'transfer over ID
    .Range("B" & NrSUM).Resize(lrf).Value = WsF.Range("B1:B" & lrf).Value 'transfer over c
    .Range("E" & NrSUM).Resize(lrf).Value = WsF.Range("E1:E" & lrf).Value 'transfer over N
    .Range("G" & NrSUM).Resize(lrf).Value = WsF.Range("L1:L" & lrf).Value 'transfer over Type of File
    .Range("H" & NrSUM).Resize(lrf).Value = WsF.Range("M1:M" & lrf).Value 'transfer over File Name
    .Cells.EntireColumn.AutoFit
    .Range("6:6").AutoFilter
    .Activate
End With