copy till last row from specific row number with cell reference - excel

I have the below code where I need to make it work as below.
copy from row 10 till last row with value.
the last row will be with reference to column N starting from cell N10..
any suggestions from SO team?
wbSource.Sheets(SITE_TEMPLATE).Rows(10).EntireRow.Copy wbMaster.Sheets(SITE_TEMPLATE).Range("A" & insertRow2)
insertRow2 = insertRow2 + 1

Try this:
Sub test()
Dim LastRow As Long
With Workbooks("wbSource").Worksheets("SITE_TEMPLATE")
LastRow = .Cells(.Rows.Count, "N").End(xlUp).Row
.Rows(10 & ":" & LastRow).EntireRow.Copy wbMaster.Sheets(SITE_TEMPLATE).Range("A" & insertRow2)
insertRow2 = insertRow2 + 1
End With
End Sub

Related

How to fix a sum formula that changes ranges

Sub formu
Range(“d” & Rows.count).end(xlUp).offset(2,0).formular1c1 = “=sum(R[-9]c:r[-1]c)”
End sub
Currently this is my formula but it changes on a weekly basis so I t could be R[-14]c:r[-1]c the next week or R[-6]c:r[-1]c the next week. How do I get my formula to change weekly so I don’t have to manually re sum the cell?
Say the following would be your current weeks data:
The following code would add a formula in the cell below the last cell:
Sub formu()
Dim lr As Long
With Formulas
lr = .Cells(.Rows.Count, 4).End(xlUp).Row
.Cells(lr + 1, 4).FormulaR1C1 = "=sum(R[-" & lr & "]c:r[-" & lr - (lr - 1) & "]c)"
End With
End Sub
Whereas the sheet reference is the sheet codename containing the data. Output:
The formula in that cell is currently:
=SUM(R[-10]C:R[-1]C)
You can find a sheet's CodeName in the project explorer and give it a meaningfull name to reference directly :)
First of all, is important to know if your weekly report always put the information in te same order. For example all the numbers start in the Range("A2"). If that the case i recomend you to work whit TagNames. Asuming that the data you need to sum start in the Range("A2")
Dim Col as integer
Dim sRow, eRow as long 's = start, e = end
Col = Range("A2").Column 'Col = 1
sRow = Range("A2").Row 'sRow = 2
eRow = Range("A2").Rnd(xlDown).Row 'eRow = row of the last cell with information to sum
Range(Cells(sRow,Col),Cells(eRow,Col)).Name = "range2Sum" 'Yo assign a tagname
'The you can use what you have done
Range(“d” & Rows.count).end(xlUp).offset(2,0).formula = “=sum(range2Sum)” 'use that tagname that is visible in excel

Filldown columns from cells value in each worksheet

What I am trying to do is to take values from specific cells and make them a filldown column. I have multiple worksheets with different values in them.
This code is working as expected with one worksheet :
Sub Formatting_one()
Range("A12").Value = Range("M6").Value
Range("A12:A" & Cells(Rows.Count, 7).End(xlUp).Row).FillDown
End Sub
Then, I started to try the same thing but with looping through worksheets. That's the point I am stuck with. Here is my code for this :
Sub Formatting_many()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.[A1].Resize(, 6).EntireColumn.Insert
ws.Range("A12").Value = ws.Range("M6").Value
ws.Range("A12:A" & Cells(Rows.Count, 7).End(xlUp).Row).FillDown
ws.Range("B12").Value = ws.Range("M7").Value
ws.Range("B12:B" & Cells(Rows.Count, 7).End(xlUp).Row).FillDown
ws.Range("C12").Value = ws.Range("M8").Value
ws.Range("C12:C" & Cells(Rows.Count, 7).End(xlUp).Row).FillDown
ws.Range("D12").Value = ws.Range("I5").Value
ws.Range("D12:D" & Cells(Rows.Count, 7).End(xlUp).Row).FillDown
ws.Range("E12").Value = ws.Range("I4").Value
ws.Range("E12:E" & Cells(Rows.Count, 7).End(xlUp).Row).FillDown
ws.Range("F12").Value = ws.Range("I6").Value
ws.Range("F12:F" & Cells(Rows.Count, 7).End(xlUp).Row).FillDown
ws.Range("G12").Value = ws.Range("I7").Value
ws.Range("G12:G" & Cells(Rows.Count, 7).End(xlUp).Row).FillDown
Next ws
End Sub
I did a step by step, and the result is that the cell is copied in the first cell of the filldown range cells but then it's deleted. Can somebody help ?
The issue …
… is that you look for the last used row in column G
Cells(Rows.Count, 7).End(xlUp).Row
But since you added 6 columns with ws.[A1].Resize(, 6).EntireColumn.Insert column G is now empty, so the last used row is 1
and you actually run
ws.Range("A12:A1").FillDown
which takes the empty cell from A1 and fills it down until A12 (so your inserted value in A12 gets removed).
Solution
After inserting your original column G moved to
ws.Cells(ws.Rows.Count, 7 + 6).End(xlUp).Row

VBA Find & Replace Row based on reference, if not found then paste at row at bottom

I'll try to explain this best as I can, and I attached an example pic of what I'm looking for help on.
Sheet 1 represents new data that comes into the workbook, Sheet 2 represents older data saved on the work book. I would like to run a script that replaces the whole row of data in Sheet 2 from Sheet 1 based on its matching reference. If Sheet 1 has an entry that does not find a matching a reference in Sheet 2, it then pastes the new value as the last row. This would ideally run as a loop until the last row of Sheet 1.
I tried working on it & come with this code. Hope this helps.
Sub insert()
Dim i As Integer
lastrow = Sheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
'SheetTwoEmptyRow = Sheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Row
Dim rgfound As Range
For i = 1 To lastrow
Set rgfound = Worksheets("sheet1").Range("A1:A500").Find("A" & i)
If rgfound Is Nothing Then
Worksheets("sheet1").Range("A" & i, "C" & i).Copy _
Destination:=Worksheets("sheet2").Range("E" & i, "G" & i)
Else
'do nothing
End If
Next i
End Sub

if column A has text and column G is blank then copy row to new spreadsheet

I am trying to create a summary list for people in a downstream application to feed several of my production machines. Each machine is going to have their own tab to request material, and I want all of their requests to be summarized on one tab (called "Core_Cutter_List").
So basically I am trying to create a VBA that will copy over a row from spreadsheet "2" into the next blank line on spreadsheet "Core_Cutter_List". I want it to copy if there is text in column A and column G is blank. I have limited knowledge of VBA. The code that I found was able to only test for one of my criteria which was that column G is blank, but basically it runs through every single cell on my file. Do you know how I can add the other criteria of column A having text in it so that it doesn't look through every cell on my sheet? Thanks for any help!
Sub Test()
'
' Test Macro
'
Sheets("2").Select
For Each Cell In Sheets(1).Range("G:G")
If Cell.Value = "" Then
matchRow = Cell.Row
Rows(matchRow & ":" & matchRow).Select
Selection.Copy
Sheets("Core_Cutting_List").Select
ActiveSheet.Rows(matchRow).Select
ActiveSheet.Paste
Sheets("2").Select
End If
Next
End Sub
If you need two conditions, then you should write them carefully in the IF statement with And:
Something like If cell.Value = "" And Len(cell.Offset(0,-6)) Then should be workable.
Using Select is a bit not advisable, but it works at the beginning - How to avoid using Select in Excel VBA
The Sub bellow does the following
Determine the last used row in Worksheets("2") based on values in column A
Determine the last used col in Worksheets("2") based on values in row 1
Determine the last used row in Worksheets("Core_Cutter_List") based on values in column A
Loop through all used rows in Worksheets("2")
If the cell in col A is not empty And cell in col G is empty
Copy entire row to next empty row in Worksheets("Core_Cutter_List")
Increment next empty row for Worksheets("Core_Cutter_List")
Loop to the next used row in Worksheets("2")
Option Explicit
Public Sub CopyRows()
Dim ws1 As Worksheet, ws2 As Worksheet, ws1r As Range, ws2r As Range
Dim ws1lr As Long, ws1lc As Long, ws2lr As Long, i As Long
Set ws1 = ThisWorkbook.Worksheets("2")
Set ws2 = ThisWorkbook.Worksheets("Core_Cutter_List")
ws1lr = ws1.Range("A" & Rows.Count).End(xlUp).Row 'last row in "2"
ws1lc = ws1.Cells(1, Columns.Count).End(xlToLeft).Column 'last col in "2"
ws2lr = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1 'last row in "Core_Cutter"
For i = 1 To ws1lr
If Len(ws1.Cells(i, "A")) > 0 And Len(ws1.Cells(i, "G")) = 0 Then
Set ws1r = ws1.Range(ws1.Cells(i, 1), ws1.Cells(i, ws1lc))
Set ws2r = ws2.Range(ws2.Cells(ws2lr, 1), ws2.Cells(ws2lr, ws1lc))
ws2r.Value2 = ws1r.Value2
ws2lr = ws2lr + 1
End If
Next i
End Sub
My test file
Worksheets("2")
Worksheets("Core_Cutter_List")

vba delete row not working properly

I have been trying to modify the data in a work sheet with some VBA, unfortunately the following code I'm using is not working properly.
Basically column A has the text, and I want to delete the entire row if the column A is "Pit" (not containing "Pit", but only "Pit"). For some reason the code is only deleting some rows but not others, so I have to keep running the script a few times to get rid of all the "Pit"s. There is nothing distinctly different between the rows it deletes and the ones it does not, they are all text & no spaces. There are thousands of rows with different column A text. Here is the code, I would greatly appreciate any suggestions.
Sub Pitdelete()
Dim lastrow As Long
Dim datasheet As Worksheet
Dim i As Long
Set datasheet = Worksheets("DefCatCou")
lastrow = datasheet.Range("a" & datasheet.Rows.Count).End(xlUp).Row
For i = 2 To lastrow
If datasheet.Cells(i, 1) = "Pit" Then
datasheet.Rows(i & ":" & i).EntireRow.delete
End If
Next i
End Sub
Thanks!
Just loop backwards when deleting rows:
Sub Pitdelete()
Dim lastrow As Long
Dim datasheet As Worksheet
Dim i As Long
Set datasheet = Worksheets("DefCatCou")
lastrow = datasheet.Range("a" & datasheet.Rows.Count).End(xlUp).Row
For i = lastrow To 2 step -1 'This should fix it.
If datasheet.Cells(i, 1) = "Pit" Then
datasheet.Rows(i & ":" & i).EntireRow.delete
End If
Next i
End Sub
Reason is that when you delete a row and increase the i with one, you basically skip the next row, since the delete shifted that one up.
The alternative is to add i = i - 1 after the EntireRow.Delete line.
Each time you delete a row all the rows below it move up.
You can declare another variable like this and increase it each time you delete row:
Dim c as Integer
c = 0
If datasheet.Cells(i, 1) = "Pit" Then
datasheet.Rows(i - c & ":" & i - c).EntireRow.delete
c = c + 1
...
#zipa is quite right - when you delete a row, the others move up, changing their index. As an alternative to his proposal, you can get the loop to run in reverse:
For i = lastrow To 2 Step -1
If datasheet.Cells(i, 1) = "Pit" Then
datasheet.Rows(i & ":" & i).EntireRow.delete
End If
next i
That way, if you delete a row, it won't affect the next index in your loop.

Resources