help with macro last row and appending

J

jordanburch

Active Member
Joined
Jun 10, 2016
Messages
440
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

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
Sort by date Sort by votes
jordanburch said:
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
Click to expand...
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
 
Upvote 0
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
 
Upvote 0
Jeffrey Mahoney said:
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
Click to expand...
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!
 
Upvote 0
Jeffrey Mahoney said:
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
Click to expand...
Hi Jeff,

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

Jordan
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question
import based on partial filename
Replies
3
Views
494
GWteB
GWteB
J
  • Question
dim sheet 2 as sheet name
Replies
2
Views
768
Joe4
Joe4
J
  • Solved
insert filename into column
Replies
3
Views
462
Fluff
Fluff
J
  • Solved
else without if error
Replies
4
Views
473
jordanburch
J
J
  • Question
help! Looping through folder simple adjustment
Replies
3
Views
306
JLGWhiz
JLGWhiz

Forum statistics

Threads
1,214,572
Messages
6,120,306
Members
448,955
Latest member
Dreamz high

Share this page

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
Back
Top