Loop Reading Wrong Value

[jalrs]

Hello guys,

I managed to get a code almost working without any assistance, purely based on my former doubts and the assistance I got there. Happens I'm with a small problem, I believe, and I can't seem to work around it.

What the code is intended to do is read values on sheet "Macro1", open those cell value files on a specific location, copy them from sheet "Pendentes" and paste them to sheet "Refresh". It should paste under the last filled row. It's working for the first cell value, but for the second it displays an error saying that file doesn't exist because when it loops it's reading the value from "Refresh" sheet cells, instead of "Macro1" sheet cells.

Here is the code:

Option Explicit
Sub mergingmacro1()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet
Dim lr1 As Long, lr2 As Long, lr3 As Long, lr4 As Long, i As Long
Dim mypath As String, docname As String, filtervalue As String

Set wb2 = ThisWorkbook
Set ws2 = wb2.Worksheets("Refresh")
Set ws3 = wb2.Worksheets("Macro1")

lr1 = ws2.Cells(Rows.Count, "A").End(xlUp).Row + 1 'check where is the last filled row on Refresh Sheet, +1 regarding the headers on row 1 i believe
lr2 = ws3.Cells(Rows.Count, "A").End(xlUp).Row 'check where is the last filled row on Macro1 Sheet. Each row equals to one department

ws3.Activate 'activates Macro1 sheet

    For i = 1 To lr2 'first area on row one, so i value equals to 1. loops untill lr2, where last area is found
       
        filtervalue = Cells(i, 1).Value 'filtervalue equals each area name, according to each row on macro1 sheet
       
        Workbooks.Open Filename:=ThisWorkbook.Path & "\Recebidos\ST_" & Cells(i, 1).Value & ".xlsx" 'opens each row area workbook
       
        Set wb3 = Workbooks("ST_" & filtervalue & ".xlsx")
       
        Set ws4 = wb3.Worksheets("Pendentes")
       
        lr3 = ws4.Cells(Rows.Count, "A").End(xlUp).Row 'finds where is the last row filled with data to be able to copy it
       
        With ws2.Range("A2:BC" & lr1) 'because it's where we are going to paste all the data - merge, lr1 here is due to rows being dynamic prior to previous area rows of data, ie, I can have two rows of data for i1, so i2 would start on row 4, if I would have 3 sets of data for i1, i2 would start on row 5. remember headers are on row 1
       
            With ws4 'because it's where we copy the data as individuals - before merging
           
                .Range("A2:BC" & lr3).Copy 'copies data from ws4
                ws2.Cells(lr1, 1).PasteSpecial Paste:=xlPasteValues 'pastes ws4 data as values on ws2, ws2 is the refresh sheet on the merging workbook
               
            End With
           
        End With
       
        Application.CutCopyMode = False
       
    Next i
   
ws2.Activate 'when the loop ends, we activate ws2

ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "Atualizar ST" & ".xlsx", FileFormat:=xlOpenXMLWorkbook 'in order to not lose the template, we saveas on the same destination with a new name

ActiveWorkbook.Close 'close the brand new renamed workbook

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Any help is greatly appreciated
Thanks!

 

[jalrs]

@jairs Sorry for delayed response but have been non-comunicado for a couple of days.
That's great. You have working code and it does look to be tidily coded. If it works and you are happy with it then keep it as is.

Any comments I make now are perhaps being rather picky.
Bear in mind that non of what I say is tested. Hopefully I have neither been careless of misinterpreted anything.

The main thing I would do different is to code a transfer of values rather than unnecessarily use Copy/ Paste Special Values.
That generally removes any need for selections or activations etc.
There are one or two other comments I have made within the code that hopefully make sense.
Eg I would have some of the last row calcs outside the loop and then just increment them +1 within the loop.
I also offer an alternative to Opening the filtervalue file which might avoid any annoyance as those files open / close.

Sub integrar()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet
Dim lr1 As Long, lr2 As Long, lr3 As Long, lr4 As Long, lr5 As Long, lr6 As Long, lr7 As Long, i As Long
Dim mypath As String, docname As String, filtervalue As String

Set wb1 = ThisWorkbook
Set ws1 = wb1.Worksheets("PainelControlo")
Set ws2 = wb1.Worksheets("MACRO 1")
Set ws3 = wb1.Worksheets("TFDB")


'ws2.Activate  *** not necessary if not using Copy Paste?

lr1 = ws2.Cells(Rows.Count, "E").End(xlUp).Row

        '****compute these last rows just once, outside the loop and then increment within the loop ?
        lr2 = ws3.Cells(Rows.Count, "B").End(xlUp).Row
        lr3 = ws3.Cells(Rows.Count, "C").End(xlUp).Row
        lr4 = ws3.Cells(Rows.Count, "D").End(xlUp).Row



    For i = 2 To lr1
  
        lr2 = lr2 + 1
        lr3 = lr3 + 1
        lr4 = lr4 + 1
      
        filtervalue = Cells(i, 5).Value
  
      
   '**********************
       '** Could now use the variable filtervalue ?
       Workbooks.Open FileName:=ThisWorkbook.Path & "\Controlo e Difusão\Feedbacks Recebidos\" & filtervalue & ".xlsx"
        Set wb2 = Workbooks(filtervalue & ".xlsx")  '***   ??  "" & ??
      
        Set ws4 = wb2.Worksheets("Pendentes")
    '*********************
      
      '!!!!**********
      'If the above generates annoying flashes of file opening then maybe do by replacing above with single line below?
      'Remove '***   to actuate the below and comment out or delete the above
    
     '*** Set ws4 = GetObject(ThisWorkbook.Path & "\Controlo e Difusão\Feedbacks Recebidos\" & filtervalue & ".xlsx").Worksheets("Pendentes")
         
      '!!!!**********
      
            With ws4
          
                'Can bring these 3 last row statements into the With if you wish ?
                lr5 = .Cells(Rows.Count, "D").End(xlUp).Row
                lr6 = .Cells(Rows.Count, "AT").End(xlUp).Row
                lr7 = .Cells(Rows.Count, "AX").End(xlUp).Row
          
            'If pasting only values, why use Copy paste.  Just assign values?
             
                ws3.Cells(lr2, 2).Value = .Range("D2:D" & lr5).Value
          
                ws3.Cells(lr3, 3).Value = .Range("AT2:AT" & lr6).Value
              
                ws3.Cells(lr4, 4).Value = .Range("AX2:AZ" & lr7).Value
              
            End With
       '**************
        wb2.Close      'Original
        ''*************
      
        '!!!!!*********** Or alternatively if non-opening file, swap for below
        '*** ws4.Parent.Close SaveChanges:=False
        '!!!!!***********
      
        'Application.CutCopyMode = False  ***Redundant if not usingCopy Paste ?
      
        'ws2.Activate  *** not necessary if not using Copy Paste?
      
    Next i
  
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Hope that helps.

Hey @Snakehips ,

Thanks for the effort you put in, I'll try on sunday when I have the company laptop with me and see if I get the same results.

Thank you! Have a nice weekend!

 

[jalrs]

@jairs Sorry for delayed response but have been non-comunicado for a couple of days.
That's great. You have working code and it does look to be tidily coded. If it works and you are happy with it then keep it as is.

Any comments I make now are perhaps being rather picky.
Bear in mind that non of what I say is tested. Hopefully I have neither been careless of misinterpreted anything.

The main thing I would do different is to code a transfer of values rather than unnecessarily use Copy/ Paste Special Values.
That generally removes any need for selections or activations etc.
There are one or two other comments I have made within the code that hopefully make sense.
Eg I would have some of the last row calcs outside the loop and then just increment them +1 within the loop.
I also offer an alternative to Opening the filtervalue file which might avoid any annoyance as those files open / close.

Sub integrar()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet
Dim lr1 As Long, lr2 As Long, lr3 As Long, lr4 As Long, lr5 As Long, lr6 As Long, lr7 As Long, i As Long
Dim mypath As String, docname As String, filtervalue As String

Set wb1 = ThisWorkbook
Set ws1 = wb1.Worksheets("PainelControlo")
Set ws2 = wb1.Worksheets("MACRO 1")
Set ws3 = wb1.Worksheets("TFDB")


'ws2.Activate  *** not necessary if not using Copy Paste?

lr1 = ws2.Cells(Rows.Count, "E").End(xlUp).Row

        '****compute these last rows just once, outside the loop and then increment within the loop ?
        lr2 = ws3.Cells(Rows.Count, "B").End(xlUp).Row
        lr3 = ws3.Cells(Rows.Count, "C").End(xlUp).Row
        lr4 = ws3.Cells(Rows.Count, "D").End(xlUp).Row



    For i = 2 To lr1
  
        lr2 = lr2 + 1
        lr3 = lr3 + 1
        lr4 = lr4 + 1
      
        filtervalue = Cells(i, 5).Value
  
      
   '**********************
       '** Could now use the variable filtervalue ?
       Workbooks.Open FileName:=ThisWorkbook.Path & "\Controlo e Difusão\Feedbacks Recebidos\" & filtervalue & ".xlsx"
        Set wb2 = Workbooks(filtervalue & ".xlsx")  '***   ??  "" & ??
      
        Set ws4 = wb2.Worksheets("Pendentes")
    '*********************
      
      '!!!!**********
      'If the above generates annoying flashes of file opening then maybe do by replacing above with single line below?
      'Remove '***   to actuate the below and comment out or delete the above
    
     '*** Set ws4 = GetObject(ThisWorkbook.Path & "\Controlo e Difusão\Feedbacks Recebidos\" & filtervalue & ".xlsx").Worksheets("Pendentes")
         
      '!!!!**********
      
            With ws4
          
                'Can bring these 3 last row statements into the With if you wish ?
                lr5 = .Cells(Rows.Count, "D").End(xlUp).Row
                lr6 = .Cells(Rows.Count, "AT").End(xlUp).Row
                lr7 = .Cells(Rows.Count, "AX").End(xlUp).Row
          
            'If pasting only values, why use Copy paste.  Just assign values?
             
                ws3.Cells(lr2, 2).Value = .Range("D2:D" & lr5).Value
          
                ws3.Cells(lr3, 3).Value = .Range("AT2:AT" & lr6).Value
              
                ws3.Cells(lr4, 4).Value = .Range("AX2:AZ" & lr7).Value
              
            End With
       '**************
        wb2.Close      'Original
        ''*************
      
        '!!!!!*********** Or alternatively if non-opening file, swap for below
        '*** ws4.Parent.Close SaveChanges:=False
        '!!!!!***********
      
        'Application.CutCopyMode = False  ***Redundant if not usingCopy Paste ?
      
        'ws2.Activate  *** not necessary if not using Copy Paste?
      
    Next i
  
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Hope that helps.

Hello there Snakehips,

As I said, I did try it, unfortunately it doesn't work. Stops at

Workbooks.Open

It's all good tho! At least I got something working thanks to you!

Thanks!