i would like to come up with vba sub that searching value from one specified cell (job) across all sheets and then pastes rows but only with selected columns. If value not found any error message instead paste value.
I know it's bigger project but I'm fresh so try to my best.
As far i have solution for whole rows:
Sub TEST()
Dim tws As String
Dim l_row As String
Dim l_rowR As String
Dim job As String
Dim i As Integer
Set tws = ThisWorkbook.Sheets("Data")
tws.Range("A20") = "STATS:"
job = tws.Range("B5")
lastRow = Worksheets("Sheet1").Range("E" & Rows.Count).End(xlUp).Row
lastRowRpt = tws.Range("A" & Rows.Count).End(xlUp).Row
For i = 3 To lastRow
If Worksheets("Sheet1").Range("E" & i).Value = job And _
Worksheets("Sheet1").Range("D" & i).Value = "x2" Then
Worksheets("Sheet1").Rows(i).Copy
lastRowRpt = tws.Range("A" & Rows.Count).End(xlUp).Row
tws.Range("A" & lastRowRpt + 1).Select
tws.Paste
End If
Next i
End Sub
Related
I have written a code which gives me the errors (if any cell is non numeric) in a separate sheet called "Error_sheet".
But the output is a bit clumsy as it gives me non numeric cell address in a confusing fashion. Like the errors will not be pasted one after another. There will be some blanks in between if there are more than one non Numeric cells.
Sub Test()
Dim LastRow As Long, i As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To LastRow
If IsNumeric(Range("A" & i).Value) Then
Else
Sheets("Error").Range("A" & Row).Value = "Error in" & i & " row of ColumnNAme"
Row = Row + 1
End If
Next i
End Sub
It gives me output like shown below but can I get the output like Error in 7,14 rows of column name in a desired cell of "Error_sheet".
[![Output][1]][1]
[1]: https://i.stack.imgur.com/JqXwq.png
My understanding of what you've written is that you want something like this.
Option Explicit
Sub Test()
' Unqualified book/sheet below, means code will always run the isnumeric check on the cells of the active sheet. Is that what you want? '
Dim LastRow As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Dim Index as long
Dim i As Long
Dim NonNumericRows() as string
Redim NonNumericRows(1 to lastrow)
For i = 2 To LastRow
If not(IsNumeric(Range("A" & i).Value)) Then
Index = index + 1
NonNumericRows(Index) = cstr(i)
End if
Next i
Redim preserve NonNumericRows(1 to index)
Sheets("Error").Range("A1").Value = "Error in row(s): " & strings.join(nonnumericrows,", ") & " of ColumnNAme"
End Sub
Hope it works or helps.
Like QHarr suggested, using Option Explicit is normally a good idea, and try not to use VBA operators as variables.
Also when working with more than 1 sheet, its best to define each in the code. I dont know what your first sheet is called, so please change the line: Set shSource = Sheets("Sheet1") to suit:
Option Explicit
Sub SubErrorSheet()
Dim lr As Long, i As Long
Dim shSource As Worksheet, shError As Worksheet
Set shSource = Sheets("Sheet1")
Set shError = Sheets("Error")
lr = shSource.Range("A" & Rows.count).End(xlUp).Row
For i = 2 To lr
If Not IsNumeric(shSource.Range("A" & i).Value) Then
shError.Range("A" & Rows.count).End(xlUp).Offset(1, 0).Value = "Error in row " & i & " of ColumnNAme"
End If
Next i
End Sub
I am relatively new to VBA.
I have a target workbook where the first step is somebody has to write something. If not an error message pops up.
After they filled in their data the code will ask them to open the source workbook(they downloaded the file before). From the source workbook certain columns are read. This all works fine in the code. The problem I have is to get what they filled in the target workbook to be copied down in column (A4:A(last row in source workbook). So the length until where their manually entered data has to be copied down has to be equal to the length of data in the source workbook.
Sub get_rate_codes()
Dim CheckCell As Range
Dim wb_source As Workbook
Dim wb_target As Workbook
Dim strPathName As String
Dim lastRow As Long
For Each CheckCell In Sheets("rate_codes").Range("F3").Cells
If Len(Trim(CheckCell.Value)) = 0 Then
CheckCell.Select
MsgBox "Cell " & CheckCell.Address(0, 0) & " is empty. Please enter SITA."
Exit Sub
End If
Next CheckCell
'start to open file
Application.ScreenUpdating = False
'start is the starting cell while lastRow measures the last data row in the external file
Start = 4
'continue to copy data from the rate codes report
Set wb_target = ActiveWorkbook
With wb_target.Sheets("rate_codes")
lastRow = wb_source.UsedRange.SpecialCells(xlCellTypeLastCell).Row
strPathName = Application.GetOpenFilename()
If strPathName = "False" Then
Exit Sub
End If
Set wb_source = Workbooks.Open(strPathName, 0)
.Range("B" & Start & ":B1000").Value = wb_source.Sheets(1).Range("E2:E1000").Value
.Range("C" & Start & ":C1000").Value = wb_source.Sheets(1).Range("H2:H1000").Value
.Range("D" & Start & ":D1000").Value = wb_source.Sheets(1).Range("G2:G1000").Value
.Range("E" & Start & ":E1000").Value = wb_source.Sheets(1).Range("K2:K1000").Value
.Range("A" & Start & ":A" & lastRow).Value = wb_target.Sheets(2).Range("F2").Value '
wb_source.Close (False)
End With
'close file without saving
Application.ScreenUpdating = True
End Sub
To find the last row you can do this.
Dim lastRow As Long
lastRow = wb_source.Cells(wb_source.Rows.count, "A").End(xlUp).Row
Then you can write to the next line.
.Range("A" & lastRow + 1).Value =
My original question was posted here.
Basically I needed some help transferring data from one sheet to another based on values in the first sheet. I am using a modified bit of code provided by user keong kenshih.
I added an additional check against another row to the IF statement, and I have this for my code:
Option Explicit
Dim MyWorkbook As Workbook
Dim MyWorksheet As Worksheet
Dim MyOutputWorksheet As Worksheet
So I need to output only certain columns. Also I need them to import to certain rows and columns on the second sheet, the CONTRACT sheet. Column A on the MAIN sheet goes to column A starting at row 17 on the CONTRACT sheet. B to B , E to D, F to E, all starting at row 17 on the CONTRACT sheet.
Rows 17-42 on the CONTRACT sheet will contain data.
Sub PullData()
Set MyWorkbook = Workbooks(ActiveWorkbook.Name)
Set MyWorksheet = MyWorkbook.Sheets("MAIN")
Set MyOutputWorksheet = MyWorkbook.Sheets("CONTRACT")
Dim myValue As Long
Dim RowPointer As Long
For RowPointer = 6 To MyWorksheet.Cells(Rows.Count, "B").End(xlUp).Row
If MyWorksheet.Range("A" & RowPointer).V alue > 0 And
MyWorksheet.Range("A" & RowPointer).Value <> ""
MyWorksheet.Range("F" & RowPointer).Value > 0 And
MyWorksheet.Range("F" & RowPointer).Value <> ""Then
If MyOutputWorksheet.Cells(Rows.Count, "B").End(xlUp).Row > 15
Then
Exit Sub
End If
MyWorksheet.Range(("A" & RowPointer) & ":C" & RowPointer).Copy
Destination:=MyOutputWorksheet.Range("A" &
MyOutputWorksheet.Cells(Rows.Count, "B").End(xlUp).Row + 1)
End If
Next RowPointer
End Sub
Give this a try :
Sub PullData()
Dim wRow As Long, _
RowPointer As Long, _
MyWorkbook As Workbook, _
Ws As Worksheet, _
OutWs As Worksheet
Set MyWorkbook = Workbooks(ActiveWorkbook.Name)
Set Ws = MyWorkbook.Sheets("MAIN")
Set OutWs = MyWorkbook.Sheets("CONTRACT")
With Ws
For RowPointer = 6 To .Cells(.Rows.Count, "B").End(xlUp).Row
If .Range("A" & RowPointer).Value > 0 And _
.Range("A" & RowPointer).Value <> "" And _
.Range("F" & RowPointer).Value > 0 And _
.Range("F" & RowPointer).Value <> "" Then
'This line would get you out of the loop after the first copy because _
'You first paste on line 17 and then the below left part will be equal to 18
'If OutWs.Cells(OutWs.Rows.Count, "B").End(xlUp).Row > 15 Then Exit Sub
wRow = OutWs.Rows(OutWs.Rows.Count).End(xlUp).Row + 1
'Always start copy after (or at) line 17
If wRow <= 17 Then wRow = 17
'More efficient way to copy data between ranges
OutWs.Range("A" & wRow).Value = Ws.Range("A" & RowPointer)
OutWs.Range("B" & wRow).Value = Ws.Range("B" & RowPointer)
OutWs.Range("D" & wRow).Value = Ws.Range("E" & RowPointer)
OutWs.Range("E" & wRow).Value = Ws.Range("F" & RowPointer)
End If
Next RowPointer
End With
Set MyWorkbook = Nothing
Set Ws = Nothing
Set OutWs = Nothing
End Sub
This code is to open files and go to a certain sheet, grab everything from A11 to AC(down), go back to a report and progressively paste it one after the other, which works with the exception that it can't find the next available row so it pastes the new data over the previous data. I am quite sure that my efforts with LastRowSrce and LastRowDest is the culprit but I can't get it right. I saw some posts with UsedRange so I tried that but couldn't get it right either.
Any help greatly appreciated.
Sub CSReport()
Dim y As Long
Dim Wkb As Workbook
Dim Wks As Worksheet
Dim SFile As String 'srce file
Dim GWB As String 'dest file
Dim R1 As Range
Dim R2 As Range
Dim LastRowSrce As Long 'find last row in srce file
Dim LastRowDest As Long 'find last row in dest file
Set Wkb = thisWorkBook
Set Wks = Wkb.Worksheets("CS Report")
Wks.Range("A11:AD10000").ClearContents
Wks.Range("A4").value = "Status at " & Time & " " & Format(Date, "Long date")
y = 11 'start row
SFile = Wkb.Path & "\"
GWB = Dir(SFile & "*Audit*")
Do While Len(GWB) > 0
workbooks.Open fileName:=SFile & GWB
LastRowSrce = workbooks(GWB).Worksheets("Audit Plan").Cells(Rows.Count, "A").End(xlUp).Row
LastRowDest = Wks.Cells(Rows.Count, "A").End(xlUp).Row + 1
Set R1 = workbooks(GWB).Worksheets("Audit Plan").Range("A" & y & ":AB" & LastRowSrce)
Set R2 = Wks.Range("A" & y & ":AB" & LastRowSrce)
R2.value = R1.value
workbooks(GWB).Close False
y = y + 1
GWB = Dir
Loop
Wkb.Save
End Sub
Set R2 = Wks.Range("A" & y & ":AB" & LastRowSrce)
you keep setting the same range on the destination sheet... you need it to be dynamic.
set R2 = Wks.Range("A" & LastRowDest & ":AB" & LastRowDest+LastRowSrce-11)
try that...
i have code which finds the last non empty row in an existing excel file. i want to insert data from 5 textbox to the next 5cells in column. i dont know how to code it. please help me, here is my code:
With xlWorkSheet
If EXL.WorksheetFunction.CountA(.Cells) <> 0 Then
lRow = .Cells.Find(What:="*", _
After:=.Range("A2"), _
LookAt:=Excel.XlLookAt.xlPart, _
LookIn:=Excel.XlFindLookIn.xlFormulas, _
SearchOrder:=Excel.XlSearchOrder.xlByRows, _
SearchDirection:=Excel.XlSearchDirection.xlPrevious, _
MatchCase:=False).Row
Else
lRow = 1
End If
End With
Here are two different solutions to your problem. I like the second better because you can determine a lastrow from any column and if you cared reference it to another column.
Dim nextrow As Integer = excel.Rows.End(XlDirection.xlDown).Row + 1
Dim ws As Worksheet = excel.ActiveSheet
Dim nRow = ws.Range("A" & ws.Rows.Count).End(XlDirection.xlUp).Row + 1
Then all you have to do to assign a value is:
excel.Range("A" & nRow).Value = "test"
excel.range("B" & nRow).value = "adjacent column"
If you want to loop it to 5 cells below that then do:
Dim ws As Worksheet = excel.ActiveSheet
Dim lRow = ws.Range("A" & ws.Rows.Count).End(XlDirection.xlUp).Row
For i = 1 To 5
excel.Range("A" & lRow).Offset(i, 0).Value = "variable here"
Next