I have no experience with VBA and it's proving to be more difficult than what I imagined...in part because I don't know the syntax, but I have the following:
Sub testMe()
LastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
Worksheets("Sheet2").Range("A1").Copy Destination:=Range("A" & LastRow)
End Sub
This kinda works, but it's jamming everything into one cell in the first column. How do I merge the cells of the last row before pasting into it? The macro is supposed to find the last row of the last page, merge the cells of that row, and paste text that was copied from another cell. Thank you in advance.
This should do what you're after. You should just change the column number to reflect the column which you wish to merge cells until.
Option Explicit
Sub copy_and_paste_merge()
Dim last_row As Long
last_row = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(1, 1).Copy
Cells(last_row, 1).PasteSpecial Paste:=xlPasteValues
Range(Cells(last_row, 1), Cells(last_row, 5)).MergeCells = True 'change the column
End Sub
I ended up doing it like this...
Sub testMe()
LastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
Range("A" & LastRow & ":L" & LastRow).Merge
Range("A" & LastRow) = Worksheets("Sheet2").Range("A1")
End Sub
Related
I'm struggling to adapt my code now I've built out my sheet.
My code to clear the whole row is
Sub dontdeleteallrows()
Dim a
a = [MATCH(TRUE,INDEX(ISNUMBER(A1:A10000),0),0)]
If Not IsNumeric(x) Then Exit Sub
Rows(a & ":" & Rows.Count).Delete
End Sub
What can I replace Rows(a & ":" & Rows.Count).Delete with to delete cells AA to JA?
Do you want to delete the cells or clear them of content?
If you want to delete the cells, other content may need to move left or up. Where do you want it to go?
You might do something like
Range("Aa" & a & ":Ja" & a).clear
If you want to check Column A for empty cell value and delete the entire row you could use the below:
Option Explicit
Sub Delete()
Dim LastRow As Long, i As Long
With ThisWorkbook.Worksheets("Sheet1")
'Find the last row
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'Loop column A
For i = LastRow To 1 Step -1
'Check if cell is empty
If .Range("A" & i).Value = "" Then
'Delete row
.Rows(i).EntireRow.Delete
End If
Next i
End With
End Sub
There is a master order form that has several SKU numbers on it such as 22-1,22-99, 11-1,11-22 etc. What I have been struggling to do is identify all the cells that start with the same number and then select the entire row to move them to a new worksheet. The code provided moves a single cell but I have to move the entire row next with that cell.
Sub Findandcut()
Dim row As Long
For row = 2 To 1000
' Check if "save" appears in the value anywhere.
If Range("A" & row).Value Like "*save*" Then
' Copy the value and then blank the source.
Range("I" & row).Value = Range("A" & row).Value
Range("A" & row).Value = ""
End If
Next
End Sub
The output needed would be all the SKUs that start with the same number get moved to a new worksheet.
Take a look at Range.EntireRow : https://learn.microsoft.com/en-us/office/vba/api/excel.range.entirerow
You can select your entire row like this:
ws.Range("*any cell in the row you want*").EntireRow.Select
then do what you want with the row (i.e, move it, copy it, etc)
Edit2: full working code which should do what you want it to do.
Sub Findandcut()
Dim row As Long
For row = 2 To 1000
' Check if "save" appears in the value anywhere.
If Range("A" & row).Value Like "*save*" Then
' Copy the value and then blank the source.
Range("A" & row).EntireRow Cut Sheet2.Range("I" & row) 'cut and paste to Sheet2
Range("A" & row).Value = "" 'delete row for cleanup purposes
End If
Next
End Sub
Sub Findandcut()
Dim rw As Long
Dim lastrow As Long
lastrow = Worksheets("Sheet2").UsedRange.Rows(Worksheets("Sheet2").UsedRange.Rows.Count).row
For rw = 1000 To 2 Step -1
With Worksheets("Sheet1")
' Check if "save" appears in the value anywhere.
If .Cells(rw, 1).Value Like "*11-*" Then
' Cut the value and then blank the source and shift up
.Cells(rw, 2).EntireRow.Cut Destination:=Worksheets("Sheet2").Cells(lastrow, 1)
.Cells(rw, 2).EntireRow.Delete (xlUp)
End If
End With
lastrow = Worksheets("Sheet2").UsedRange.Rows(Worksheets("Sheet2").UsedRange.Rows.Count).row +1
Next
End Sub
I think this should do what you are looking for.
When I run the code below, my range, Master, pastes twice, once with content, and once with empty cells.
Sub AddProj() 'Adds new template to Data Worksheet
Sheet1.Range("Master").Copy
Sheet1.Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlFormats
FindProj
End Sub
When my code is like below, it works properly but doesn't paste formatting:
Sub AddProj() 'Adds new template to Data Worksheet
Sheet1.Range("Master").Copy Sheet1.Range("C" & Rows.Count).End(xlUp).Offset(1)
FindProj
End Sub
FindProj is just some function to copy and paste a cell:
Sub FindProj() 'Finds project name in Historical Worksheet and pastes it in Data Worksheet
Dim Lastrow As Long
Dim Newproj As Long
Dim Master As Range
Dim Masterrow As Long
Masterrow = Worksheets("Data").Range("Master").Rows.Count
Lastrow = Sheets("Historical").Cells(Rows.Count, "B").End(xlUp).Row
Newproj = Sheets("Data").Cells(Rows.Count, "C").End(xlUp).Row
Sheets("Historical").Cells(Lastrow, "B").Copy Sheets("Data").Cells(Newproj - Masterrow + 1, "C")
End Sub
Also, the first code only works once and then never again.
Obviously the PasteSpecial is messing things up but I can't see why. Is there a way to incorporate PasteSpecial into the second code?
Will this help?
Sheet1.Range("Master").Copy
With Sheet1.Range("C" & Rows.Count).End(xlUp).Offset(1)
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteValues
End With
I need to constantly start at cell R2 and auto-fill a formula down to the last row of column R. However, the number of rows is constantly changing so I need to write a macro that finds the last row and stops there. My code, as it stands right now, will auto-fill column R to the end of the worksheet (not to the row where my data stops). How do I get the auto-fill to stop at the correct row where there is no longer any data?
Sub InvoicePrice()
Dim Lastrow As Long
Lastrow = Range("P" & Rows.Count).End(xlDown).Row
Range("R2").Select
ActiveCell.FormulaR1C1 = "=RC[-2]/RC[-4]"
Selection.AutoFill Destination:=Range("R2:R" & Lastrow)
End Sub
Try this (avoids select/activate):
Dim Lastrow As Long
'Lastrow = Range("P" & Rows.Count).End(xlDown).Row
Lastrow=Cells(Rows.Count, "P").End(xlUp).Row
Range("R2:R" & Lastrow).FormulaR1C1 = "=RC[-2]/RC[-4]"
set r = range("R2")
If r.Offset(1, 0) <> "" Then
lastRow = r.End(xlDown).row
Else
lasRow = r.row
End If
I'm looking to 'normalize' a column of data by setting the minimum value to 0 and shifting the entire column's data by the difference of the min value and 0.
The code should be simple, but I can't find the appropriate range selection to stop the code when it reaches a blank cell.
Below is the core that I've unsuccessfully been working off of trying to recognize the first empty cell in column U after U9 up to U700 and correspondingly stop subtracting in column Z. Example screenshots are attached. Thank you!
Private Sub CommandButton1_Click()
[Z9:Z700] = [U9:U700-U8]
End Sub
This is what I get:
This is what I would like to get:
Try this:
Sub foo()
Dim lRow As Long
With ActiveSheet
lRow = .Cells(Rows.Count, "U").End(xlUp).Row
.Range("U9:U" & lRow).Copy .Range("Z9")
With .Range("U8")
.Formula = "=MIN(U9:U" & lRow & ")"
.Copy
End With
.Range("Z9:Z" & lRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlSubtract
Application.CutCopyMode = False
End With
End Sub
EDIT:
If you have formulas in Column U, below your list of numbers, which are returning blank values, then this revision might work better for you:
Sub foo2()
Dim lRows As Long
With ActiveSheet
lRows = WorksheetFunction.Count(.Range("U9:U700"))
.Range("U8").Formula = "=MIN(" & .Range("U9").Resize(lRows, 1).Address(0, 0) & ")"
.Range("U9").Resize(lRows, 1).Copy
.Range("Z9").PasteSpecial Paste:=xlPasteValues
.Range("U8").Copy
.Range("Z9").Resize(lRows, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlSubtract
End With
Application.CutCopyMode = False
End Sub