help with macro last row and appending

jordanburch

Active Member
Joined
Jun 10, 2016
Messages
344
Office Version
  1. 2016
Hey gUys,
I have the following macro below. I am running it in four different places with four different files. Its the same macro just change the variables each time. Its not copying and pasting over correctly I expect to see droughly 50k lines, but it only produces 20 k which seems to only pull through two of the files. I believe it might be the end row function is wrong but am not sure. Any ideas?

VBA Code:
Sub COSARimportfinal21currentmonth()
Dim MyFile As String
Dim erow As Long
Dim Filepath As String
Dim wb1 As Workbook, wb2 As Workbook
Dim data_wbk4 As String
    Dim data_wbk2 As String
   
    Dim fn As String
    Dim fn2 As String
    Dim fn3 As String
    Dim fn4 As String
    Dim ShtName1 As String
    Dim ShtName2 As String
    Dim ShtName3 As String
    ShtName1 = "Detail Lines"
    ShtName2 = "Detail"
    ShtName3 = "Detail -"
   
    data_wbk4 = InputBox("Enter FY I.E. FY20", Default:="FY20")
data_wbk2 = InputBox("Enter month I.E. 08-MAY20", Default:="08-MAY20")
data_wbk6 = InputBox("Enter month Name I.E. YYYYMM:", Default:="202005")
fn4 = Right(data_wbk2, 5)
fn = Left(data_wbk2, 6)
fn2 = Right(data_wbk2, 2)
fn3 = Right(data_wbk6, 2)
Application.ScreenUpdating = False
Worksheets.Add(After:=Worksheets(1)).Name = "CO SAR"
Set wb1 = ThisWorkbook

data_wbk6 = InputBox("Enter month Name I.E. YYYYMM:", Default:="202005")

Filepath = "K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\Source Files\21 Field Details\" & data_wbk4 & "\" & data_wbk2 & "\Field Detail Lines\"
'K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\DRP\2020 DRP\2020-05 Reporting Cycle
MyFile = "CO21army" & fn4 & ".xlsx"


    erow = wb1.Sheets("CO SAR").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Set wb2 = Workbooks.Open(Filepath & MyFile)
    With wb2
   
   
    Dim ShtName As String
ShtName = "Sheet 1"
If Evaluate("isref('" & ShtName & "'!A1)") Then
   'sheet exists do something
Else
   'sheet doesn't exist do something else
End If
   If Evaluate("isref('" & ShtName1 & "'!A1)") Then
  
        .Sheets("Detail Lines").Range("a2:p1000").Copy Destination:=wb1.Worksheets("CO SAR").Cells(erow, 1)
        .Close savechanges:=False
        ElseIf Evaluate("isref('" & ShtName3 & "'!A1)") Then
        .Sheets("Detail Lines").Range("a2:p1000").Copy Destination:=wb1.Worksheets("CO SAR").Cells(erow, 1)
        .Close savechanges:=False
       
        ElseIf Evaluate("isref('" & ShtName2 & "'!A1)") Then
        .Sheets("Detail Lines").Range("a2:p1000").Copy Destination:=wb1.Worksheets("CO SAR").Cells(erow, 1)
        .Close savechanges:=False
       
        End If
       
       
       
    End With
  
Application.ScreenUpdating = True
End Sub
 
Last edited by a moderator:

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.

jordanburch

Active Member
Joined
Jun 10, 2016
Messages
344
Office Version
  1. 2016
Hey gUys,
I have the following macro below. I am running it in four different places with four different files. Its the same macro just change the variables each time. Its not copying and pasting over correctly I expect to see droughly 50k lines, but it only produces 20 k which seems to only pull through two of the files. I believe it might be the end row function is wrong but am not sure. Any ideas?

VBA Code:
Sub COSARimportfinal21currentmonth()
Dim MyFile As String
Dim erow As Long
Dim Filepath As String
Dim wb1 As Workbook, wb2 As Workbook
Dim data_wbk4 As String
    Dim data_wbk2 As String
  
    Dim fn As String
    Dim fn2 As String
    Dim fn3 As String
    Dim fn4 As String
    Dim ShtName1 As String
    Dim ShtName2 As String
    Dim ShtName3 As String
    ShtName1 = "Detail Lines"
    ShtName2 = "Detail"
    ShtName3 = "Detail -"
  
    data_wbk4 = InputBox("Enter FY I.E. FY20", Default:="FY20")
data_wbk2 = InputBox("Enter month I.E. 08-MAY20", Default:="08-MAY20")
data_wbk6 = InputBox("Enter month Name I.E. YYYYMM:", Default:="202005")
fn4 = Right(data_wbk2, 5)
fn = Left(data_wbk2, 6)
fn2 = Right(data_wbk2, 2)
fn3 = Right(data_wbk6, 2)
Application.ScreenUpdating = False
Worksheets.Add(After:=Worksheets(1)).Name = "CO SAR"
Set wb1 = ThisWorkbook

data_wbk6 = InputBox("Enter month Name I.E. YYYYMM:", Default:="202005")

Filepath = "K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\Source Files\21 Field Details\" & data_wbk4 & "\" & data_wbk2 & "\Field Detail Lines\"
'K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\DRP\2020 DRP\2020-05 Reporting Cycle
MyFile = "CO21army" & fn4 & ".xlsx"


    erow = wb1.Sheets("CO SAR").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    Set wb2 = Workbooks.Open(Filepath & MyFile)
    With wb2
  
  
    Dim ShtName As String
ShtName = "Sheet 1"
If Evaluate("isref('" & ShtName & "'!A1)") Then
   'sheet exists do something
Else
   'sheet doesn't exist do something else
End If
   If Evaluate("isref('" & ShtName1 & "'!A1)") Then
 
        .Sheets("Detail Lines").Range("a2:p1000").Copy Destination:=wb1.Worksheets("CO SAR").Cells(erow, 1)
        .Close savechanges:=False
        ElseIf Evaluate("isref('" & ShtName3 & "'!A1)") Then
        .Sheets("Detail Lines").Range("a2:p1000").Copy Destination:=wb1.Worksheets("CO SAR").Cells(erow, 1)
        .Close savechanges:=False
      
        ElseIf Evaluate("isref('" & ShtName2 & "'!A1)") Then
        .Sheets("Detail Lines").Range("a2:p1000").Copy Destination:=wb1.Worksheets("CO SAR").Cells(erow, 1)
        .Close savechanges:=False
      
        End If
      
      
      
    End With
 
Application.ScreenUpdating = True
End Sub
if anyone is wondering basically this is scanning the first colmun here

erow = wb1.Sheets("CO SAR").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

I changed it to the 16th column as there is always data there and it works perfectly.

erow = wb1.Sheets("CO SAR").Cells(Rows.Count, 16).End(xlUp).Offset(1, 0).Row
 

Jeffrey Mahoney

Well-known Member
Joined
May 31, 2015
Messages
1,830
Office Version
  1. 365
Platform
  1. Windows
I looked at the code and made some changes. Good job at find the issue. Were you expecting all of the 3 sheets to be copied from WB2 or only one of them? Right now if Detail Lines exist, only that sheet will be copied.


The changes I made will speed things up because it only copies the values and not the formatting too.

VBA Code:
Sub COSARimportfinal21currentmonth()
    Dim MyFile As String
    Dim erow As Long
    Dim Filepath As String
    Dim wb1 As Workbook, wb2 As Workbook
    Dim data_wbk4 As String
    Dim data_wbk2 As String
    
    Dim R As Range
    Dim OutR As Range
    Dim EndCel As Range
    Dim NewSheetName As String
    Dim NewSht As Worksheet
   
    Dim fn As String
    Dim fn2 As String
    Dim fn3 As String
    Dim fn4 As String
    Dim ShtName1 As String
    Dim ShtName2 As String
    Dim ShtName3 As String
    ShtName1 = "Detail Lines"
    ShtName2 = "Detail"
    ShtName3 = "Detail -"
    NewSheetName = "CO SAR"
   
    data_wbk4 = InputBox("Enter FY I.E. FY20", Default:="FY20")
    data_wbk2 = InputBox("Enter month I.E. 08-MAY20", Default:="08-MAY20")
    data_wbk6 = InputBox("Enter month Name I.E. YYYYMM:", Default:="202005")
    fn4 = Right(data_wbk2, 5)
    fn = Left(data_wbk2, 6)
    fn2 = Right(data_wbk2, 2)
    fn3 = Right(data_wbk6, 2)
    Application.ScreenUpdating = False
    Worksheets.Add(After:=Worksheets(1)).Name = NewSheetName
    Set wb1 = ThisWorkbook
    Set NewSht = wb1.Sheets(NewSheetName)
    
    'data_wbk6 = InputBox("Enter month Name I.E. YYYYMM:", Default:="202005")
    
    Filepath = "K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\Source Files\21 Field Details\" & data_wbk4 & "\" & data_wbk2 & "\Field Detail Lines\"
    'K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\DRP\2020 DRP\2020-05 Reporting Cycle
    MyFile = "CO21army" & fn4 & ".xlsx"


    'erow = NewSht.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    EndCel = NewSht.Cells(NewSht.Cells(Rows.Count, 16).End(xlUp).Offset(1, 0).Row, 1)
    Set wb2 = Workbooks.Open(Filepath & MyFile)
    With wb2
   
   
'      Dim ShtName As String
'      ShtName = "Sheet 1"
'      If Evaluate("isref('" & ShtName & "'!A1)") Then
'         'sheet exists do something
'      Else
'         'sheet doesn't exist do something else
'      End If
    If Evaluate("isref('" & ShtName1 & "'!A1)") Then
      
      [COLOR=rgb(184, 49, 47)]Set R = .Sheets(ShtName1).Range("a2:p1000")
      Set OutR = NewSht.Range(EndCel, EndCel.Offset(R.Rows.Count - 1, R.Columns.Count - 1))
      OutR.Value = R.Value[/COLOR]
      '.Sheets("Detail Lines").Range("a2:p1000").Copy Destination:=wb1.Worksheets("CO SAR").Cells(erow, 1)
      .Close savechanges:=False
     ElseIf Evaluate("isref('" & ShtName3 & "'!A1)") Then
      Set R = .Sheets(ShtName3).Range("a2:p1000")
      Set OutR = NewSht.Range(EndCel, EndCel.Offset(R.Rows.Count - 1, R.Columns.Count - 1))
      OutR.Value = R.Value
      '.Sheets("Detail Lines").Range("a2:p1000").Copy Destination:=wb1.Worksheets("CO SAR").Cells(erow, 1)
      .Close savechanges:=False
     
     ElseIf Evaluate("isref('" & ShtName2 & "'!A1)") Then
      Set R = .Sheets(ShtName2).Range("a2:p1000")
      Set OutR = NewSht.Range(EndCel, EndCel.Offset(R.Rows.Count - 1, R.Columns.Count - 1))
      OutR.Value = R.Value
      '.Sheets("Detail Lines").Range("a2:p1000").Copy Destination:=wb1.Worksheets("CO SAR").Cells(erow, 1)
      .Close savechanges:=False
     
     End If
       
       
       
    End With
  
Application.ScreenUpdating = True
End Sub
 

jordanburch

Active Member
Joined
Jun 10, 2016
Messages
344
Office Version
  1. 2016
I looked at the code and made some changes. Good job at find the issue. Were you expecting all of the 3 sheets to be copied from WB2 or only one of them? Right now if Detail Lines exist, only that sheet will be copied.


The changes I made will speed things up because it only copies the values and not the formatting too.

VBA Code:
Sub COSARimportfinal21currentmonth()
    Dim MyFile As String
    Dim erow As Long
    Dim Filepath As String
    Dim wb1 As Workbook, wb2 As Workbook
    Dim data_wbk4 As String
    Dim data_wbk2 As String
   
    Dim R As Range
    Dim OutR As Range
    Dim EndCel As Range
    Dim NewSheetName As String
    Dim NewSht As Worksheet
  
    Dim fn As String
    Dim fn2 As String
    Dim fn3 As String
    Dim fn4 As String
    Dim ShtName1 As String
    Dim ShtName2 As String
    Dim ShtName3 As String
    ShtName1 = "Detail Lines"
    ShtName2 = "Detail"
    ShtName3 = "Detail -"
    NewSheetName = "CO SAR"
  
    data_wbk4 = InputBox("Enter FY I.E. FY20", Default:="FY20")
    data_wbk2 = InputBox("Enter month I.E. 08-MAY20", Default:="08-MAY20")
    data_wbk6 = InputBox("Enter month Name I.E. YYYYMM:", Default:="202005")
    fn4 = Right(data_wbk2, 5)
    fn = Left(data_wbk2, 6)
    fn2 = Right(data_wbk2, 2)
    fn3 = Right(data_wbk6, 2)
    Application.ScreenUpdating = False
    Worksheets.Add(After:=Worksheets(1)).Name = NewSheetName
    Set wb1 = ThisWorkbook
    Set NewSht = wb1.Sheets(NewSheetName)
   
    'data_wbk6 = InputBox("Enter month Name I.E. YYYYMM:", Default:="202005")
   
    Filepath = "K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\Source Files\21 Field Details\" & data_wbk4 & "\" & data_wbk2 & "\Field Detail Lines\"
    'K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\DRP\2020 DRP\2020-05 Reporting Cycle
    MyFile = "CO21army" & fn4 & ".xlsx"


    'erow = NewSht.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    EndCel = NewSht.Cells(NewSht.Cells(Rows.Count, 16).End(xlUp).Offset(1, 0).Row, 1)
    Set wb2 = Workbooks.Open(Filepath & MyFile)
    With wb2
  
  
'      Dim ShtName As String
'      ShtName = "Sheet 1"
'      If Evaluate("isref('" & ShtName & "'!A1)") Then
'         'sheet exists do something
'      Else
'         'sheet doesn't exist do something else
'      End If
    If Evaluate("isref('" & ShtName1 & "'!A1)") Then
     
      [COLOR=rgb(184, 49, 47)]Set R = .Sheets(ShtName1).Range("a2:p1000")
      Set OutR = NewSht.Range(EndCel, EndCel.Offset(R.Rows.Count - 1, R.Columns.Count - 1))
      OutR.Value = R.Value[/COLOR]
      '.Sheets("Detail Lines").Range("a2:p1000").Copy Destination:=wb1.Worksheets("CO SAR").Cells(erow, 1)
      .Close savechanges:=False
     ElseIf Evaluate("isref('" & ShtName3 & "'!A1)") Then
      Set R = .Sheets(ShtName3).Range("a2:p1000")
      Set OutR = NewSht.Range(EndCel, EndCel.Offset(R.Rows.Count - 1, R.Columns.Count - 1))
      OutR.Value = R.Value
      '.Sheets("Detail Lines").Range("a2:p1000").Copy Destination:=wb1.Worksheets("CO SAR").Cells(erow, 1)
      .Close savechanges:=False
    
     ElseIf Evaluate("isref('" & ShtName2 & "'!A1)") Then
      Set R = .Sheets(ShtName2).Range("a2:p1000")
      Set OutR = NewSht.Range(EndCel, EndCel.Offset(R.Rows.Count - 1, R.Columns.Count - 1))
      OutR.Value = R.Value
      '.Sheets("Detail Lines").Range("a2:p1000").Copy Destination:=wb1.Worksheets("CO SAR").Cells(erow, 1)
      .Close savechanges:=False
    
     End If
      
      
      
    End With
 
Application.ScreenUpdating = True
End Sub
thanks this works great! I need the formatting its for accountants which tend to be very particular about their formatting lol. ALso, I just used that sheet because it was an import i used for a different file and just changed the sheet name there is only one sheet name in each file. Thanks again!
 

jordanburch

Active Member
Joined
Jun 10, 2016
Messages
344
Office Version
  1. 2016
I looked at the code and made some changes. Good job at find the issue. Were you expecting all of the 3 sheets to be copied from WB2 or only one of them? Right now if Detail Lines exist, only that sheet will be copied.


The changes I made will speed things up because it only copies the values and not the formatting too.

VBA Code:
Sub COSARimportfinal21currentmonth()
    Dim MyFile As String
    Dim erow As Long
    Dim Filepath As String
    Dim wb1 As Workbook, wb2 As Workbook
    Dim data_wbk4 As String
    Dim data_wbk2 As String
   
    Dim R As Range
    Dim OutR As Range
    Dim EndCel As Range
    Dim NewSheetName As String
    Dim NewSht As Worksheet
  
    Dim fn As String
    Dim fn2 As String
    Dim fn3 As String
    Dim fn4 As String
    Dim ShtName1 As String
    Dim ShtName2 As String
    Dim ShtName3 As String
    ShtName1 = "Detail Lines"
    ShtName2 = "Detail"
    ShtName3 = "Detail -"
    NewSheetName = "CO SAR"
  
    data_wbk4 = InputBox("Enter FY I.E. FY20", Default:="FY20")
    data_wbk2 = InputBox("Enter month I.E. 08-MAY20", Default:="08-MAY20")
    data_wbk6 = InputBox("Enter month Name I.E. YYYYMM:", Default:="202005")
    fn4 = Right(data_wbk2, 5)
    fn = Left(data_wbk2, 6)
    fn2 = Right(data_wbk2, 2)
    fn3 = Right(data_wbk6, 2)
    Application.ScreenUpdating = False
    Worksheets.Add(After:=Worksheets(1)).Name = NewSheetName
    Set wb1 = ThisWorkbook
    Set NewSht = wb1.Sheets(NewSheetName)
   
    'data_wbk6 = InputBox("Enter month Name I.E. YYYYMM:", Default:="202005")
   
    Filepath = "K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\Source Files\21 Field Details\" & data_wbk4 & "\" & data_wbk2 & "\Field Detail Lines\"
    'K:\SHARED\TRANSFER\Enterprise Wide Suspense Initiative\DRP\2020 DRP\2020-05 Reporting Cycle
    MyFile = "CO21army" & fn4 & ".xlsx"


    'erow = NewSht.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    EndCel = NewSht.Cells(NewSht.Cells(Rows.Count, 16).End(xlUp).Offset(1, 0).Row, 1)
    Set wb2 = Workbooks.Open(Filepath & MyFile)
    With wb2
  
  
'      Dim ShtName As String
'      ShtName = "Sheet 1"
'      If Evaluate("isref('" & ShtName & "'!A1)") Then
'         'sheet exists do something
'      Else
'         'sheet doesn't exist do something else
'      End If
    If Evaluate("isref('" & ShtName1 & "'!A1)") Then
     
      [COLOR=rgb(184, 49, 47)]Set R = .Sheets(ShtName1).Range("a2:p1000")
      Set OutR = NewSht.Range(EndCel, EndCel.Offset(R.Rows.Count - 1, R.Columns.Count - 1))
      OutR.Value = R.Value[/COLOR]
      '.Sheets("Detail Lines").Range("a2:p1000").Copy Destination:=wb1.Worksheets("CO SAR").Cells(erow, 1)
      .Close savechanges:=False
     ElseIf Evaluate("isref('" & ShtName3 & "'!A1)") Then
      Set R = .Sheets(ShtName3).Range("a2:p1000")
      Set OutR = NewSht.Range(EndCel, EndCel.Offset(R.Rows.Count - 1, R.Columns.Count - 1))
      OutR.Value = R.Value
      '.Sheets("Detail Lines").Range("a2:p1000").Copy Destination:=wb1.Worksheets("CO SAR").Cells(erow, 1)
      .Close savechanges:=False
    
     ElseIf Evaluate("isref('" & ShtName2 & "'!A1)") Then
      Set R = .Sheets(ShtName2).Range("a2:p1000")
      Set OutR = NewSht.Range(EndCel, EndCel.Offset(R.Rows.Count - 1, R.Columns.Count - 1))
      OutR.Value = R.Value
      '.Sheets("Detail Lines").Range("a2:p1000").Copy Destination:=wb1.Worksheets("CO SAR").Cells(erow, 1)
      .Close savechanges:=False
    
     End If
      
      
      
    End With
 
Application.ScreenUpdating = True
End Sub
Hi Jeff,

is there a way to easily add the filename to the q column? I need that as well.

Jordan
 

Forum statistics

Threads
1,137,114
Messages
5,679,705
Members
419,851
Latest member
Resod2

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
Top