MS Excel VBA -Exiting Loop - vba

UPDATED:
Lastrow = .Range("C" & Rows.Count).End(xlUp).Row
DurcurrRowIn = currRowIn
Do
DurcurrRowIn = DurcurrRowIn + 1
Set DurlookFor = wb.ActiveSheet.Cells(currRowIn, "C") ' value to find
Set Durlookforin = wb.ActiveSheet.Range("C" & DurcurrRowIn & ":C" & Lastrow)
'Set Durlookforin = wb.ActiveSheet.Range("C:C")
On Error Resume Next
DurStart = Application.WorksheetFunction.Index(wb.ActiveSheet.Range("F" & DurcurrRowIn & ":F" & Lastrow), WorksheetFunction.Match(DurlookFor, Durlookforin, 0))
DurEnd = Application.WorksheetFunction.Index(wb.ActiveSheet.Range("G" & DurcurrRowIn & ":G" & Lastrow), WorksheetFunction.Match(DurlookFor, Durlookforin, 0))
DurStart = Format(DurStart, "mm-dd-yyyy")
Dur1 = DurEnd - DurStart
Dur = Dur + Dur1
Loop Until Durlookforin Is Nothing
Need help exiting the loop once all the employeeIDs have been found with the Index/Match
Here is a sample of my worksheet:
Test Excel

Related

Excel Data Replication + Automated Saving PT 2

I am trying to replicate data entered from one worksheet(sheet1) into another(sheet2) and then have it save hourly on a separate line each time on sheet2. I am pulling unique cells from each row rather than the entire row from sheet1 to be saved to sheet 2 with all data being in a specific order and outputting to a single row with one value per cell and creating a new line each time it is saved. For my usage, Sheet 1 will always stay open as the active sheet where changes will be made and the data will periodically save to Sheet2 while sheet1 remains selected. I am saving every 5 seconds at this stage for troubleshooting purposes.
I need assistance on pulling values from unique cells on approximately 30 rows from sheet1 and saving it to specific cells on sheet2 while sheet1 remains open and active.
I am having the following issues so far:
1. the data will replicate on sheet1 instead of sheet2 when i have sheet1 selected and open instead of writing to sheet2 as i need it to when sheet1 is being viewed/modified actively.
here is my code so far:
Option Explicit
Public dTime As Date
Sub ValueStore()
Dim dTime As Date
Range("A" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("A2").Value
Range("B" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("B2").Value
Range("C" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("C2").Value
Range("D" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("D2").Value
Range("E" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("E2").Value
Range("F" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("F2").Value
Range("G" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("G2").Value
Range("H" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("H2").Value
Range("I" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("I2").Value
Range("J" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("J2").Value
Range("K" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("K2").Value
Range("L" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("L2").Value
Range("M" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("M2").Value
Range("N" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("N2").Value
Range("O" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("O2").Value
Range("P" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("P2").Value
Range("Q" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("Q2").Value
Range("R" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("R2").Value
Range("S" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("S2").Value
Range("T" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("T2").Value
Range("U" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("U2").Value
Range("V" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("V2").Value
Range("W" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("W2").Value
Range("X" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("X2").Value
Range("Y" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("Y2").Value
Range("Z" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("Z2").Value
Range("AA" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("AA2").Value
Range("AB" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("AB2").Value
Range("AC" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("AC2").Value
Range("AD" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("AD2").Value
Range("AE" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("AE2").Value
Call StartTimer1
End Sub
Sub StartTimer1()
dTime = Now + TimeValue("00:00:05")
Application.OnTime dTime, "ValueStore", Schedule:=True
End Sub
Sub StopTimer1()
On Error Resume Next
Application.OnTime dTime, "ValueStore", Schedule:=False
End Sub
Here is a sample of your code with the additions and changes.
1-Create worksheet variables
2-Make the last row a variable
3-Since your are writing to sheet2, put your code inside a With - End With statement
4-Ensue you put the ws1 variable in front of the range you are copying from
Dim dTime As Date
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = ActiveWorkbook.Worksheets("Sheet1")
Set ws2 = ActiveWorkbook.Worksheets("Sheet2")
Dim lRow As Long
lRow = ws2.Range("A" & Rows.Count).End(xlUp).Row
With ws2
Range("A1:A" & lRow).Offset(1).Value = ws1.Range("A2").Value
Range("B1:B" & lRow).Offset(1).Value = ws1.Range("B2").Value
Range("C1:C" & lRow).Offset(1).Value = ws1.Range("C2").Value
End With

Run-time error 5 : Invalid procedure call or argument

I've got the below code and it works completely fine for rows 1 - 46 on it's own populating one table. As soon as I replicate this with a second table to populate it throws Error1.
I've taken out everything below "' Second Table Entry " and works fine ... put back in and same error. On the "Home" sheet it actually populates the tables information but still throws the error which is stopping further vba from executing.
Any ideas? I've been all over google, stackoverflow, superuser and Microsoft MSDN and can't figure out where in the second bit of code is causing it to error.
EDIT: I've checked the debugger and it's highlighting the below code in the second table inserts
With Worksheets("Home")
.Hyperlinks.Add Anchor:=.Range("H" & row_ptr), _
Address:="", _
SubAddress:=AddStr, _
TextToDisplay:=Workbooks(ActiveWorkbook.Name).Worksheets("Audit_InFlight").Range("D" & i).Value
End With
Any help is greatly appreciated.
Error1
Run-time error '5': Invalid procedure call or argument
Private Sub Workbook_Open()
Dim row_ptr As Long
Dim i As Long
Dim i2 As Long
Dim rownbrMA_Inflight As Long
Dim rownbrAudit As Long
Dim CurrentWorkbook As Workbook
Dim InputWorksheet As Worksheet
Dim DataSourceWorksheet As Worksheet
Dim AuditDataSourceWorksheet As Worksheet
Set CurrentWorkbook = Workbooks(ActiveWorkbook.Name)
Set InputWorksheet = CurrentWorkbook.Sheets("Home")
Set DataSourceWorksheet = CurrentWorkbook.Sheets("MA_Inflight")
Set AuditDataSourceWorksheet = CurrentWorkbook.Sheets("Audit_InFlight")
InputWorksheet.Range("A30:M176").Clear
InputWorksheet.Range("A30:M176").ClearFormats
InputWorksheet.Range("A30:M176").Interior.Color = RGB(255, 255, 255)
rownbrMA_Inflight = DataSourceWorksheet.Range("C" & Rows.Count).End(xlUp).Row
row_ptr = 31
For i = 8 To rownbrMA_Inflight
If DataSourceWorksheet.Range("C" & i).Value = "Open" Then
InputWorksheet.Rows(row_ptr).Insert Shift:=xlDown 'CopyOrigin:=xlFormatFromLeftOrAbove
InputWorksheet.Range("A" & row_ptr).Value = DataSourceWorksheet.Range("E" & i).Value
InputWorksheet.Range("B" & row_ptr).Value = DataSourceWorksheet.Range("F" & i).Value
AddStr = "MA_Inflight!" & "$F$" & CStr(i)
ActiveWorkbook.Activate
Worksheets("Home").Activate
With Worksheets("Home")
.Hyperlinks.Add Anchor:=.Range("B" & row_ptr), _
Address:="", _
SubAddress:=AddStr, _
TextToDisplay:=Workbooks(ActiveWorkbook.Name).Worksheets("MA_Inflight").Range("F" & i).Value
End With
InputWorksheet.Range("C" & row_ptr).Value = DataSourceWorksheet.Range("I" & i).Value
InputWorksheet.Range("D" & row_ptr).Value = DataSourceWorksheet.Range("J" & i).Value
InputWorksheet.Range("E" & row_ptr).Value = DataSourceWorksheet.Range("L" & i).Value
row_ptr = row_ptr + 1
End If
Next i
'============================================================
' Second Table Entry
'============================================================
rownbrAudit = DataSourceWorksheet.Range("C" & Rows.Count).End(xlUp).Row
row_ptr = Empty
row_ptr = 31
For i = 8 To rownbrAudit
If AuditDataSourceWorksheet.Range("B" & i).Value <> "Closed" Then
InputWorksheet.Rows(row_ptr).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
InputWorksheet.Range("G" & row_ptr).Value = AuditDataSourceWorksheet.Range("B" & i).Value
InputWorksheet.Range("H" & row_ptr).Value = AuditDataSourceWorksheet.Range("D" & i).Value
'New code ---------------------------
AddStr = "Audit_InFlight!" & "$D$" & CStr(i)
ActiveWorkbook.Activate
Worksheets("Home").Activate
With Worksheets("Home")
.Hyperlinks.Add Anchor:=.Range("H" & row_ptr), _
Address:="", _
SubAddress:=AddStr, _
TextToDisplay:=Workbooks(ActiveWorkbook.Name).Worksheets("Audit_InFlight").Range("D" & i).Value
End With
'-----------------------------------
InputWorksheet.Range("I" & row_ptr).Value = AuditDataSourceWorksheet.Range("G" & i).Value
InputWorksheet.Range("J" & row_ptr).Value = AuditDataSourceWorksheet.Range("H" & i).Value
InputWorksheet.Range("K" & row_ptr).Value = AuditDataSourceWorksheet.Range("I" & i).Value
InputWorksheet.Range("L" & row_ptr).Value = AuditDataSourceWorksheet.Range("J" & i).Value
InputWorksheet.Range("M" & row_ptr).Value = AuditDataSourceWorksheet.Range("K" & i).Value
row_ptr = row_ptr + 1
End If
Next i
'RemoveBlankCells
'PURPOSE: Deletes single cells that are blank located inside a designated range
Dim rng As Range
'Store blank cells inside a variable
Set rng = InputWorksheet.Range("A30:E50").SpecialCells(xlCellTypeBlanks)
'Delete blank cells and shift upward
rng.Rows.Delete Shift:=xlShiftUp
End Sub

Consolidate data and provide average of the consolidated data

I am writing a macro, which will be used to consolidate data from a range of cells. I have the table with the data that I want to consolidate in sheets("1") in Range D2:J6 and the destination location is again in sheets("1") in M2:R2 (the colums M to R but they contain headers) . I have already written a part of the code below, which applies and runs for them. However, even though it doesnt say it has an error, it just wont run correctly.. I am prividing the screenshot from my excel after the macro runs ..
as you can see from the image, I want to consolidate the duplicate values in row D and print the average of the values located in columns E,F,G, H, I ,J on the same row as the consolidated values in column D. For example for the value "Gebze 6832" in column D, I want to remove it as a duplicate, make it one cell in the destination and print the average of the columns E,F,G, H, I ,J from the two rows that were consolidated next to it in the destination columns.
My code is below (UPDATE)
Dim ws As Worksheet
Dim dataRng As Range
Dim dic As Variant, arr As Variant
Dim cnt As Long
Set ws = Sheets("1")
With ws
lastrow = .Cells(.Rows.Count, "D").End(xlUp).Row 'get last row in Column D
Set dataRng = .Range("D2:D" & lastrow) 'range for Column D
Set dic = CreateObject("Scripting.Dictionary")
arr = dataRng.Value
For i = 1 To UBound(arr)
dic(arr(i, 1)) = dic(arr(i, 1)) + 1
Next
.Range("M2").Resize(dic.Count, 1) = Application.WorksheetFunction.Transpose(dic.keys) 'uniques data from Column D
.Range("Q2").Resize(dic.Count, 1) = Application.WorksheetFunction.Transpose(dic.items)
cnt = dic.Count
For i = 2 To cnt + 1
.Range("N" & i & ":P" & i).Formula = "=SUMIF($D$2:$D$" & lastrow & ",$M" & i & ",E$2:E$" & lastrow & ")/" & dic(.Range("M" & i).Value)
.Range("R" & i).Formula = "=IF(INDEX($I$2:$I$" & lastrow & ",MATCH($M" & i & ",$D$2:$D$" & lastrow & ",0))=0,N" & i & ","""")"
.Range("S" & i).Formula = "=IF(INDEX($I$2:$I$" & lastrow & ",MATCH($M" & i & ",$D$2:$D$" & lastrow & ",0))=0,Q" & i & ","""")"
.Range("T" & i).Formula = "=IF($S" & i & ">0,SUMPRODUCT(($D$2:$D$" & lastrow & "=$M" & i & ")*(($J$2:$J$" & lastrow & "-$E$2:$E$" & lastrow & ")>3%)),"""")"
Next i
.Range("M" & i).Value = "Grand Total"
.Range("N" & i & ":P" & i).Formula = "=AVERAGE(N2:N" & cnt + 1 & ")"
.Range("Q" & i).Formula = "=SUM(Q2:Q" & cnt + 1 & ")"
.Range("R" & i).Formula = "=AVERAGE(R2:R" & cnt + 1 & ")"
.Range("S" & i & ":T" & i).Formula = "=SUM(S2:S" & cnt + 1 & ")"
.Range("N2:T" & .Cells(.Rows.Count, "M").End(xlUp).Row + 1).Value = .Range("N2:T" & .Cells(.Rows.Count, "M").End(xlUp).Row + 1).Value
End With
Assuming your data is in range Column D to Column J starting from Row 2 and output has to be displayed from Column M to Column S from Row 2 following might be helpful.
Sub Demo()
Dim ws As Worksheet
Dim dataRng As Range
Dim dic As Variant, arr As Variant
Dim cnt As Long
Set ws = ThisWorkbook.Sheets("Sheet4") 'change Sheet4 to your data sheet
Application.ScreenUpdating = False
With ws
lastRow = .Cells(.Rows.Count, "D").End(xlUp).Row 'get last row in Column D
Set dataRng = .Range("D2:D" & lastRow) 'range for Column D
Set dic = CreateObject("Scripting.Dictionary")
arr = dataRng.Value
For i = 1 To UBound(arr)
dic(arr(i, 1)) = dic(arr(i, 1)) + 1
Next
.Range("M2").Resize(dic.Count, 1) = Application.WorksheetFunction.Transpose(dic.keys) 'uniques data from Column D
cnt = dic.Count
For i = 2 To cnt + 1
.Range("N" & i & ":S" & i).Formula = "=SUMIF($D$2:$D$" & lastRow & ",$M" & i & ",E$2:E$" & lastRow & ")/" & dic(.Range("M" & i).Value)
Next i
.Range("N2:S" & .Cells(.Rows.Count, "M").End(xlUp).Row).Value = .Range("N2:S" & .Cells(.Rows.Count, "M").End(xlUp).Row).Value
End With
Application.ScreenUpdating = True
End Sub
This code will give following result.

Ignore string if empty in concatenation formula

I have a formula which concatenates strings in different columns. It works great when there is data in each of the columns but if one column is blank I get an error "invalid procedure call or argument" for the string formed by the empty column. Is there a clause i can add into my code to ignore the string if it is empty?
Sub Concatenation_for_the_nation()
'Range("H2").End(xlDown).Select
Cells(rows.Count, "H").End(xlUp).Select
For i = 1 To ActiveCell.Row
Range("H" & i).Select
StrStrONE = StrStrONE & "" & Selection
Next i
Cells(1, 1).Select
'Range("I2").End(xlDown).Select
Cells(rows.Count, "I").End(xlUp).Select
For j = 1 To ActiveCell.Row
Range("I" & j).Select
StrStrTWO = StrStrTWO & "" & Selection
Next j
Cells(1, 1).Select
'Range("J2").End(xlDown).Select
Cells(rows.Count, "J").End(xlUp).Select
For k = 1 To ActiveCell.Row
Range("J" & k).Select
StrStrTHREE = StrStrTHREE & "" & Selection
Next k
Cells(1, 1).Select
'Range("K2").End(xlDown).Select
Cells(rows.Count, "K").End(xlUp).Select
For l = 1 To ActiveCell.Row
Range("K" & l).Select
StrStrFOUR = StrStrFOUR & "" & Selection
Next l
Cells(1, 1).Select
StrStrONE = Trim(StrStrONE)
StrStrTWO = Trim(StrStrTWO)
StrStrTHREE = Trim(StrStrTHREE)
StrStrTHREE = Left(StrStrTHREE, Len(StrStrTHREE) - 3)
StrStrFOUR = Trim(StrStrFOUR)
StrStrFOUR = Left(StrStrFOUR, Len(StrStrFOUR) - 3)
Cells(14, 7) = "(ISAV(" & StrStrONE & " " & StrStrTWO & " " & StrStrTHREE & ")=1 OR (" & StrStrFOUR & ")=1)=1"
Cells(14, 7).Select
End Sub
You can check if the columns are not empty by using ISBLANK() function
As user2471313 said used ISBLANK() function or I would add something like this for checking the string:
If StrStrONE<>"" and StrStrTWO<>"" and StrStrTHREE<>"" and StrStrFOUR<>"" then
StrStrONE = Trim(StrStrONE)
''''your code until end
End if

Copy data to new workbook and add specific text to each row´s value in a specific column

I am exporting data from one workbook to another workbook to T13:Tlastrow
This data, from column F in my workbook where I run this macro, I want to be put into {nyckel="TEXT HERE";} in column T in the "new" workbook, starting from row 13 (T13).
I am stuck here. So would really appreciate some help/solution. Thanks!
Sub CopyData()
Dim wkbCurrent As Workbook, wkbNew As Workbook
Set wkbCurrent = ActiveWorkbook
Dim valg, c, LastCell As Range
Set valg = Selection
Dim wkbPath, wkbFileName, lastrow As String
Dim LastRowInput As Long
Dim lrow, rwCount, lastrow2, LastRowInput2 As Long
Application.ScreenUpdating = False
' If nothing is selected in column A
If Selection.Columns(1).Column = 1 Then
wkbPath = ActiveWorkbook.Path & "\"
wkbFileName = Dir(wkbPath & "CIF LISTEN.xlsm")
Set wkbNew = Workbooks.Open(wkbPath & "CIF LISTEN.xlsm")
'Application.Run ("'C:\Users\niclas.madsen\Desktop\TEST\CIF LISTEN.xlsm'!DelLastRowData")
LastRowInput = Cells(Rows.count, "A").End(xlDown).Row
For Each c In valg.Cells
lrow = wkbNew.Worksheets(1).Range("B1").Offset(wkbNew.Worksheets(1).Rows.count - 1, 0).End(xlUp).Row + 1
lastrow2 = Range("A" & Rows.count).End(xlUp).Row
lastrow3 = Range("T" & Rows.count).End(xlUp).Row
wkbCurrent.ActiveSheet.Range("E" & c.Row).Copy Destination:=wkbNew.Worksheets(1).Range("A" & lrow)
wkbCurrent.ActiveSheet.Range("A" & c.Row).Copy Destination:=wkbNew.Worksheets(1).Range("B" & lrow)
wkbCurrent.ActiveSheet.Range("F" & c.Row).Copy Destination:=wkbNew.Worksheets(1).Range("T" & lrow)
' Standard inputs
wkbNew.Worksheets(1).Range("D13:D" & lastrow2).Value = "Ange referens och period"
wkbNew.Worksheets(1).Range("E13:E" & lastrow2).Value = "99999002"
wkbNew.Worksheets(1).Range("G13:G" & lastrow2).Value = "EA"
wkbNew.Worksheets(1).Range("H13:H" & lastrow2).Value = "2"
wkbNew.Worksheets(1).Range("M13:M" & lastrow2).Value = "SEK"
wkbNew.Worksheets(1).Range("N13:N" & lastrow2).Value = "sv_SE"
wkbNew.Worksheets(1).Range("P13:P" & lastrow2).Value = "TRUE"
wkbNew.Worksheets(1).Range("Q13:Q" & lastrow2).Value = "TRUE"
wkbNew.Worksheets(1).Range("S13:S" & lastrow2).Value = "Catalog_extensions"
'wkbNew.Worksheets(1).Range("T" & lastrow3).Value = "{Nyckelord=" & wkbNew.Worksheets(1).Range("T" & lastrow3).Value & ";}"
Next
' Trying to get this to work
LastRowInput2 = wkbNew.Worksheets(1).Range("T" & wkbNew.Sheets("Sheet1").UsedRange.Rows.count + 1).End(xlUp).Row
For i = 0 To LastRowInput2 - 13
wkbNew.Worksheets(1).Range("T" & 13 + i).Value = "{Nyckelord=" & wkbNew.Worksheets(1).Range("T" & 13 + i).Value & ";}"
Next i
' END HERE
' wkbNew.Close False
' Find the number of rows that is copied over
wkbCurrent.ActiveSheet.Activate
areaCount = Selection.Areas.count
If areaCount <= 1 Then
MsgBox "The selection contains " & Selection.Rows.count & " suppliers."
' Write it in A10 in CIF LISTEN
wkbNew.Worksheets(1).Range("A10").Value = "COMMENTS: " & Selection.Rows.count & " Suppliers Added"
Else
i = 1
For Each A In Selection.Areas
'MsgBox "Area " & I & " of the selection contains " & _
a.Rows.count & " rows."
i = i + 1
rwCount = rwCount + A.Rows.count
Next A
MsgBox "The selection contains " & rwCount & " suppliers."
' Write it in A10 in CIF LISTEN
wkbNew.Worksheets(1).Range("A10").Value = "COMMENTS: " & rwCount & " Suppliers Added"
End If
wkbNew.Worksheets(1).Activate
Application.ScreenUpdating = True
Else
MsgBox "Please select cell(s) in column A", vbCritical, "Error"
Exit Sub
End If
End Sub
OK Try
wkbNew.Worksheets(1).Range("T" & lrow).Value = "{Nyckelord=" & wkbCurrent.ActiveSheet.Range("F" & c.Row).Value & "}"
Instead of your line:
wkbCurrent.ActiveSheet.Range("F" & c.Row).Copy Destination:=wkbNew.Worksheets(1).Range("T" & lrow)
And remove the whole block marked 'Trying to get this to work
If the code is doing the right action but on the wrong cells, then the problem is in the start and end of the For loop. Your For Loop is going from row '13 + i' where i = 0 (so row 13), to row 13 + LastRowInput2 - 13 (so LastRowInput2). This seems right to me, so the problem must be with the value in LastRowInput2.
You need to correct this line:
LastRowInput2 = wkbNew.Worksheets(1).Range("T" & wkbNew.Sheets("Sheet1").UsedRange.Rows.count + 1).End(xlUp).Row
So that is gives you the correct last row input in your data. There are several approaches to finding the end of data depending on whether there may be blank cells in the middle and other factors. This may be one option:
LastRowInput2 = wkbNew.Worksheets(1).Range("T65000").End(xlUp).Row
Be sure to step through the code and verify that LastRowInput2 is set to the value you expect and then this should work.