Inserting to next empty row - vba

I am trying to insert data in the next available row however it keeps missing out lots of rows which are blank.
My code is below:
Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Set copySheet = Worksheets("Recipe creater")
Set pasteSheet = Worksheets("Recipes")
Call Pasterecipedetails
copySheet.Range("b6:g6", Range("b6:g6").End(xlDown)).Copy
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Sub Pasterecipedetails()
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Set copySheet = Worksheets("Recipe creater")
Set pasteSheet = Worksheets("Recipes")
copySheet.Range("c2:e2").Copy
pasteSheet.Cells(Rows.Count, 11).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Thanks


try like this :
copySheet.UsedRange.Copy
nextRow = pasteSheet.UsedRange.SpecialCells(xlCellTypeLastCell).row + 1
pasteSheet.Cells(nextRow, 1).PasteSpecial (xlPasteValues)

Related

VBA Excel Script - Runtime Error 424 (Code Specific)

By no means am I a VBA developer, but any help on why this isn't working would be greatly appreciated...
Problem:
Analyze all worksheets, except the last.
Check if a column I and J contain an X, if they do, get that row and copy it to the last worksheet.
Error Highlighted is at this line: For Each ws In Workbook.Worksheets. I'm not sure why.
Below is my code, but it's not compiling, and giving me the error code 424 - Object Required.
Sub CopyData()
Application.ScreenUpdating = False
Dim pasteSheet As Worksheet
Set pasteSheet = Worksheets("Remediation Summary")
For Each ws In ThisWorkbook.Worksheets
If ws.Index < (ThisWorkbook.Worksheets.Count - 1) Then
'check column i for x
For Each icell In ws.Range("i1:i200").Cells
If icell.Value Like ("X") Or ("x") Then
Rows(icell.RowIndex).Copy
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
End If
Next icell
'check column j for x
For Each jcell In ws.Range("j1:j200").Cells
If jcell.Value Like ("X") Or ("x") Then
Rows(jcell.RowIndex).Copy
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
End If
Next jcell
End If
Next ws
End Sub

Option Explicit is really a great helper - write it on the top of every module / class / worksheet. It would tell immediately, if there is some variable, which is not declared.
In your case, ws should be declared as a worksheet, as far as you are using the for-each loop to go through the Worksheets collection:
Option Explicit
Sub CopyData()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
Debug.Print ws.Name
Next ws
End Sub
Option Explicit MSDN
Concerning this part - If icell.Value Like ("X") Or ("x") Then, consider rewriting it like this:
If UCase(icell) = "X" Then. It would be more understandable and Like is not needed when the comparison is without some additional signs ?*.
Excel VBA like operator

updated codebase:
Sub CopyData()
Application.ScreenUpdating = False
Dim pasteSheet As Worksheet
Set pasteSheet = Worksheets("Remediation Summary")
For Each ws In ThisWorkbook.Worksheets
If ws.Index < (ThisWorkbook.Worksheets.Count - 1) Then
'check column i for x
For Each icell In ws.Range("i0:i200").Cells
If icell.Value Like ("X") Or ("x") Then
Rows(icell.RowIndex).Copy
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
End If
Next icell
'check column j for x
For Each jcell In ws.Range("j0:j200").Cells
If jcell.Value Like ("X") Or ("x") Then
Rows(jcell.RowIndex).Copy
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
End If
Next jcell
End If
Next ws
End Sub

Based on my test, please try the code below:
Option Explicit
Sub CopyData()
Application.ScreenUpdating = False
Dim pasteSheet As Worksheet
Dim ws As Worksheet
Dim icell As Range
Dim jcell As Range
Set pasteSheet = Worksheets("Remediation Summary")
For Each ws In ThisWorkbook.Worksheets
If ws.Index < (ThisWorkbook.Worksheets.Count - 1) Then
'check column i for x
For Each icell In ws.Range("i1:i200").Cells
If UCase(icell) = "X" Or UCase(icell) = "x" Then
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow.Value = icell.EntireRow.Value
Application.CutCopyMode = False
Application.ScreenUpdating = True
End If
Next icell
'check column j for x
For Each jcell In ws.Range("j1:j200").Cells
If UCase(jcell) = "X" Or UCase(jcell) = "x" Then
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow.Value = jcell.EntireRow.Value
Application.CutCopyMode = False
Application.ScreenUpdating = True
End If
Next jcell
End If
Next ws
End Sub

Sub CopyData()
Dim pasteSheet As Worksheet, ws As Worksheet, icell As Range
Set pasteSheet = Worksheets("Remediation Summary") 'ThisWorkbook?
For Each ws In ThisWorkbook.Worksheets
If ws.Index < (ThisWorkbook.Worksheets.Count - 1) Then
'check column i,j for x
For Each icell In ws.Range("i1:i200").Cells
If LCase(icell.Value) = "x" Or LCase(icell.Offset(0, 1).Value) = "x" Then
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow.Value = _
icell.EntireRow.Value
End If
Next icell
End If
Next ws
End Sub

Don't Allow Duplicate Entries in another sheet

I have a macro which copy paste my data in another sheet when I press the button, but it also allowing duplicate entries. I have no idea how i can stop duplicate entries to be copied.
Sub Register_Copy()
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Set copySheet = Worksheets("RACF ID")
Set pasteSheet = Worksheets("Sheet1")
copySheet.Range("C4").Copy
pasteSheet.Cells(Rows.count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
copySheet.Range("B6").Copy
pasteSheet.Cells(Rows.count, 1).End(xlUp).Offset(0, 1).PasteSpecial xlPasteValues
copySheet.Range("C6").Copy
pasteSheet.Cells(Rows.count, 1).End(xlUp).Offset(0, 2).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

It will be faster, if you avoid copy and pasting, but you record the value as a String variable and then write this string variable in column. Thus, you can also check whether the variable exists in the column before writing it.
Public Sub TestMe()
Dim newValue As Variant
newValue = copysheet.Range("C4").Value2
With pastesheet
If IsError(WorksheetFunction.Match(newValue, .Columns(3), 0)) Then
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0) = newValue
End If
End With
End Sub

Excel VBA: AutoFill Column Down Without Preset Range

How do i get Auto-fill to automatically detect the next new ID# to duplicate in the following line without having to tell/ set the excel range where the next ID# would start?
Below is the formula.
Sub NewTestRow()
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Dim LRow As Long
Set copySheet = Worksheets("Sheet1")
Set pasteSheet = Worksheets("Sheet2")
copySheet.Range("E3:K500").Copy
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
LRow = ActiveSheet.Cells(Sheets("Sheet2").Rows.Count, "A").End(xlUp).Row
Cells(2, 1).Select
Selection.Copy
ActiveSheet.Range(Cells(3, 1), Cells(LRow, 1)).Select
ActiveSheet.Paste
copySheet.Range("M3:S500").Copy
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
[EXAMPLE FORMAT IMAGE]

This code cycles through cells in the first column, and checks that it is the same as the proceeding cell in the first column. Also, I'd change "LRow =" to a better way of finding the last row, just in case there are any gaps in your data.
LRow = ActiveSheet.Cells(Sheets("Sheet2").Rows.Count, "A").End(xlUp).Row
i = 2
' --- low
While i < LRow
If ActiveSheet.Cells(i, 1) = ActiveSheet.Cells(i + 1, 1) Then
' --- new ID not found, increment to next row
i = i + 1
ElseIf
' --- Put whatever code you want to fire when a new ID is found
NewIDFound = i + 1
End If
Wend

Copy cells in adding a row in another workbook

So i have to copy cells A1, B2 and C3 from one workbook and add a row in anotherworkbook(in the last line) with theses values in the columns A,B,C.
Here's what i got so far, i think i'm close but i cant finish.
I havo no idea whats wrong with this syntax "Set lastrow = wNew.Cells.(Rows.Count, "A").End(xlUp).Row + 1" that seens to be the problem
Sub Botão1_Clique()
Dim wks As Worksheet
Dim wNew As Worksheet
Dim y As Workbook
Dim lastrow As Long
Application.ScreenUpdating = False
Set wks = ActiveSheet
Set y = Workbooks.Open("Y:\teste.xlsx")
Set wNew = y.Sheets("GERAL")
Set lastrow = wNew.Cells.(Rows.Count, "A").End(xlUp).Row + 1
wks.Cells(1, 1).Copy
wNew.Cells(lastrow, 1).PasteSpecial Paste:=xlPasteValues
wks.Cells(2, 2).Copy
wNew.Cells(lastrow, 2).PasteSpecial Paste:=xlPasteValues
wks.Cells(3, 3).Copy
wNew.Cells(lastrow, 3).PasteSpecial Paste:=xlPasteValues
Application.ScreenUpdating = True
End Sub
I also would like to close the Y:\teste.xlsx workbook, and display a message saying "ROW ADDED"

You do a good job properly referencing Workbooks and Worksheets but also make sure you fully qualify Cells and Rows. They are properties of the worksheet object I.e. ThisWorkbook.Worksheets("..").Rows
Sub Botão1_Clique()
Dim wks As Worksheet, wNew As Worksheet
Dim y As Workbook
Dim lastrow As Long
Application.ScreenUpdating = False
Set wks = ActiveSheet
Set y = Workbooks.Open("Y:\teste.xlsx")
Set wNew = y.Sheets("GERAL")
With wNew
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Cells(lastrow, 1).Value = wks.Cells(1, 1)
.Cells(lastrow, 2).Value = wks.Cells(2, 2)
.Cells(lastrow, 3).Value = wks.Cells(3, 3)
End With
'extra code as requested
y.Close True 'save changes if TRUE
MsgBox "ROW ADDED"
Application.ScreenUpdating = True
End Sub

Adding line into Excel with macro

I have this code and I am trying to get it to add a line in when copying the information accross. The issue I have is that it adds a line in between them and scrambles the information. I have a template worksheet with a total on the bottom and basicly want it pushed down as the lines are enetered.
Any help would be great
Sub SummurizeSheets()
Dim ws As Worksheet, wsSummary As Worksheet
Dim c As Range
Range("A4:D31").Select
Selection.ClearContents
Application.ScreenUpdating = False
Set wsSummary = Sheets("Summary")
' Set destination cell
Set c = wsSummary.Range("A4")
For Each ws In Worksheets
If ws.Name <> "Summary" Then
ActiveCell.EntireRow.Insert
ws.Range("D1").Copy
c.PasteSpecial (xlPasteValues)
ws.Range("E4").Copy
c.Offset(0, 1).PasteSpecial (xlPasteValues)
ws.Range("J39").Copy
c.Offset(0, 2).PasteSpecial (xlPasteValues)
' Move destination cell one row down
Set c = c.Offset(1, 0)
End If
Next ws
Application.ScreenUpdating = True
End Sub

Try this then:
Sub SummurizeSheets()
Dim ws As Worksheet, wsSummary As Worksheet
Dim c As Range
Application.ScreenUpdating = False
Set wsSummary = Sheets("Summary")
Set c = wsSummary.Range("$A$4")
For Each ws In Worksheets
If ws.Name <> "Summary" Then
c.EntireRow.Insert xlDown, xlFormatFromLeftOrAbove
Set c = c.Offset(-1, 0)
ws.Range("D1").Copy
c.PasteSpecial xlPasteValues
ws.Range("E4").Copy
c.Offset(0, 1).PasteSpecial xlPasteValues
ws.Range("J39").Copy
c.Offset(0, 2).PasteSpecial xlPasteValues
End If
Next ws
Application.ScreenUpdating = True
End Sub