I'm very new to VBA and I'm trying to get a macro to look up the next empty row in a sheet and then copy the row number and then paste that value into another workbook.
This is as far as I've got.
Sub Retrieve_Row_Number ()
Dim erow As Integer
erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Workbooks.Open "\\hamfile\public\(P) Maintenance\MJR_Status.xlsm", ReadOnly
ActiveSheet.Cells(erow, 1).Select
I've seen the ActiveCell.Row function used with MsgBox to display the row number but I'd like to copy it so it can be used as a cell value pasted into the second sheet
If anyone can give me code to copy a row number of a selected row to the clipboard it would be hugely appreciated
Try using the below code:
Sub RowAdd()
Dim eRow As Integer
ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Select
eRow = ActiveCell.Offset(1, 0).Row
Workbooks.Open "\\hamfile\public\(P) Maintenance\MJR_Status.xlsm", ReadOnly
ActiveSheet.Cells(eRow, 1).Select
End Sub
Related
I have "Out of memory" issue with my Excel and VBA when I try to run macro below
Sub CopyPaste() ' macro to copy dynamic range
Dim lRow As Long
Dim sht As Worksheet
Set sht = Sheets("SQL")
sht.Activate
lRow = sht.Cells(sht.Rows.Count, 2).End(xlUp).Row
sht.Range("A1:Q" & lRow).Copy
Workbooks.Add
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("A:Q").EntireColumn.AutoFit
End Sub
My idea is to copy dynamic range from SQL tab in excel and paste to new workbook as values, columns to be autofit and all cells centered.
I have powerful machine at home, tried to reboot it and restart excel just in case.
Please, try the next adapted code. It does not activate, select anything. They are useless, only consuming Excel resources. Since you try copying only values, you also do not need using Clipboard:
Sub CopyPaste() ' macro to copy dynamic range
Dim lRow As Long, sht As Worksheet
Set sht = Sheets("SQL")
lRow = sht.cells(sht.rows.count, 2).End(xlUp).row 'last row on B:B column
Workbooks.Add
With sht.Range("A1:Q" & lRow)
ActiveSheet.Range("A1").Resize(.rows.count, .Columns.count).Value = .Value
End With
Columns("A:Q").EntireColumn.AutoFit
End Sub
If B:B is not the column you like to be the reference for the last used range cell, please change it using the necessary column number (instead of 2 in sht.cells(sht.rows.count, 2))
If you like using Clipboard, the next code will be suitable:
Sub CopyPaste() ' macro to copy dynamic range
Sheets("SQL").Copy 'it creates a new workbook with THAT single sheet
'in case of existing columns after Q:Q, use the next code to clear. If not, delete the next code lines:
Dim lastCol As Long
lastCol = ActiveSheet.cells(1, .ActiveSheet.Columns.count).End(xlToLeft).column
If lastCol > 17 Then
Range(cells(1, 18), cells(1, lastCol)).EntireColumn.Clear
End If
End Sub
If no any column after Q:Q, the code may have only a code line...
I have an Excel 2013 worksheet where each column has a header row, and then the word "DIRECT" in some or all of the cells. No other data exists in the columns, just "DIRECT" or blanks. No columns are blank, they all have "DIRECT" at least once.
I'm looking for a macro that does the following:
Adds a new top row
Ignores the original header row, but gets a count of the cells with "DIRECT" in them
Puts that number in the corresponding new top cell for each column
Does the above actions for each column in the worksheet
Works regardless of the last column or row with data (I have to run this on several different-sized worksheets)
I recorded a macro that gets close, but it has two problems:
It adds the COUNTA data out to the last row of the workbook, which isn't needed (the populated columns will be a couple hundred, not thousands)
It references a specific cell range, so could cut off data for sheets with more rows
Sub AddColumnCountsRecorded()
'
' AddColumnCounts Macro
'
'
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("J1").Select
ActiveCell.FormulaR1C1 = "=COUNTA(R[2]C:R[15]C)"
Range("J1").Select
Selection.Copy
Range(Selection, Selection.End(xlToRight)).Select
ActiveSheet.Paste
End Sub
If it helps:
Column "A" can determine the last row where data could be (that's the "username" column", so no blanks there) - although this last row will also change from sheet to sheet.
Row 2 (the header row) can determine the last column where data could be - it has no blank columns; in each column, at least one cell will have the word "DIRECT".
Any advice on editing the existing macro or concocting a new one from scratch would be greatly appreciated!
Thanks!
UPDATE:
Much thanks to Scott, here's what I ended up with - this adds the non-blank cell count to the active worksheet and stops at the last row with data in it. I just call it directly, without the 2nd section of code proposed below:
Sub AddColumnCountsRecorded()
With ActiveSheet
.Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Dim lRow As Long, lCol As Long
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
lCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
.Range(.Cells(1, 2), .Cells(1, lCol)).FormulaR1C1 = "=COUNTA(R[2]C:R[" & lRow & "]C)"
End With
End Sub
Give this a shot. I made a separate sub that you can pass the worksheet reference too.
Sub AddColumnCountsRecorded(ws As Worksheet)
With ws
.Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Dim lRow As Long, lCol As Long
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
lCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
.Range(.Cells(1, 2), .Cells(1, lCol)).FormulaR1C1 = "=COUNTA(R[2]C:R[" & lRow & "]C)"
End With
End Sub
Call it like this:
Sub ColumnCount()
AddColumnCountsRecorded Worksheets("Sheet1")
End Sub
I have one of each ID (e.g. only one X and one Y) but I want each ID to repeat ten times with the corresponding number next to it.
I have very limited experience with VBA but this is a problem that seems to be solvable by VBA only.
What would the VBA code be?
If I understand correctly, you just want to copy each row in the file 10 times.
Try this:
Sub Macro1()
Dim i As Integer
Dim lastRow As Integer
Dim row As Integer
With ActiveSheet
lastRow = .Cells(.Rows.Count, "A").End(xlUp).row
End With
Range("A1").Activate
For row = 1 To lastRow
For i = 1 To 9
Rows(ActiveCell.row).Select
Selection.Copy
Selection.Insert Shift:=xlDown
ActiveCell.Offset(1, 0).Activate
Next i
ActiveCell.Offset(1, 0).Activate
Next row
End Sub
The issue is that I have a function that deletes rows containing specific text:
Sub DeleteRowsContaining(text As String)
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
With ActiveSheet
'Set the first and last row to loop through
Firstrow = .UsedRange.Cells(2).Row
Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
'We loop from Lastrow to Firstrow (bottom to top)
For Lrow = Lastrow To Firstrow Step -1
'We check the values in the A column
With .Cells(Lrow, "A")
If Not IsError(.Value) Then
If .Value = text Then .EntireRow.Delete
'This will delete each row with the Value of text
'in Column A, case sensitive.
End If
End With
Next Lrow
End With
End Sub
After executing this code block I then would like to select the remaining text, however, any rows that were deleted from the end of a column still count when using the
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
command. The real issue is the error that happens when using the next command which is
Selection.End(xlDown).Offset(1, 0).Select
When using that command, if you have more than two empty rows selected, an error will be thrown. At this point I am at a loss, as all the ways that I can easily and dynamically check for the end of my data range are returning the location of a blank cell.
I am not sure if there is another way to delete a row that does not leave a cell selectable as if it had data, or if there is a way to trim the empty rows from a selection when excel seems to believe that the rows have something there.
Once you have completed deleting unwanted rows, to select the rows that remain run:
Sub SelectTheRest()
Dim N As Long
N = Cells(Rows.Count, "A").End(xlUp).Row
Range("A1:A" & N).EntireRow.Select
End Sub
I have 2 sheets, sheet 1 has a cell with total price formula on it. I want to copy that cell on sheet 1 to sheet 2 column G2 going down every time I click on the macro (UPDATE button) with a new price total.
I have tried recording a macro but whenever I click the update button it paste the cell but with a REF! error or a value 0.
can anyone help me.
thanks
range("b3").select
application.cutcopypaste=false
selection.copy
sheets("sheets2").select
range("b4").select
selection.insert shift:=xldown
This is the simplest answer:
Sheets("Source Sheet Name").Range("B3").Copy
Sheets("Destination Sheet Name").Range("G" & Range("G" & Rows.Count).End(xlUp).Row + 1).Paste
Variant without copy
Sub test()
Sheets("Sheet2").Cells(Rows.Count, 7).End(xlUp).Offset(1, 0).Value = Sheets("Sheet1").Range("B3").Value
End Sub
Variant with copy method
Sub test2()
Sheets("Sheet1").Range("B3").Copy Sheets("Sheet2").Cells(Rows.Count, 7).End(xlUp).Offset(1, 0)
End Sub
Another one vatiant using copy method
Sub test3()
Sheets("Sheet1").[B3].Copy
Sheets("Sheet2").Cells(Rows.Count, "G").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End Sub