I'm trying to create a macro in which it takes a dynamic number of rows (user inputted) and pastes them into a table in a different sheet. I was having a difficult time searching and finding ways for doing this at first. I have a workaround below that works the first time (it correctly takes the 'raw' range and pastes it into the table) when I run it from VBA but crashes when I press the macro-assigned button right after. My code is below:
Sub AddRawData()
Dim count_of_data As Long
Dim rng As Range
Set rng = Sheets("New Input Raw Data").Range("B5", Range("B5").End(xlDown).End(xlToRight))
count_of_data = rng.Rows.Count
Sheets("Master Data").Select
For x = 1 To count_of_data
ActiveSheet.ListObjects(1).ListRows.Add
Next x
Sheets("New Input Raw Data").Select
rng.Select
rng.Cut
Sheets("Master Data").Select
Range("b65536").End(xlUp).End(xlUp).Select
ActiveCell.Offset(1).Select
ActiveSheet.Paste
End Sub
I'm stuck at the moment and have tried various work arounds like using ActiveCell.paste or Range.Paste, but run into the same crashing issue. Any suggestions or code corrections would be greatly appreciated. Thank you!
If you want to copy the new inserted data from New Input Raw Data worksheet to the end of existing data in Master Data sheet, you don't need all the Select and most of the lines, you can just run the code below:
Sub AddRawData()
Dim rng As Range
Dim sht_NewData As Worksheet
Dim sht_MasterData As Worksheet
Set sht_NewData = ThisWorkbook.Worksheets("New Input Raw Data")
Set sht_MasterData = ThisWorkbook.Worksheets("Master Data")
sht_NewData.Select
Set rng = sht_NewData.Range("B5", Range("B5").End(xlDown).End(xlToRight))
rng.Copy Destination:=sht_MasterData.Range("B" & sht_MasterData.Cells(sht_MasterData.Rows.Count, "B").End(xlUp).Row + 1)
End Sub
Related
I would like to copy a range in one sheet and paste it as a value in another sheet, but just in a specific range in the next available cell in column B. Starting from B4 to B23 only.
I changed some code I found online but it's not working for me in finding the next available row. After I run the macro the first time, when I run it again and again it does nothing, and it's not working in pasting only the values either.
I tried saving the file before running the Macro again, but still it's not working.
At the end, when the range in the Print sheet is full, I would like a message box asking me to select one of the printers (not the default) on one of my servers (specifying the server path in the code like \a_server_name) and print this Print Sheet only, or clear the records in the range in the Print Sheet, or save only the Sheet Print in a new file (SaveAs) to a location I can choose on one of my servers (specifying the server path in the code \a_server_name) or simply do nothing and end the sub.
Thank you.
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Set copySheet = Worksheets(“Data”)
Set pasteSheet = Worksheets("Print”)
copySheet.Range("J11:Q11").Copy
pasteSheet.Range("B4:I23").End(xlUp).Offset(1,0)
.PasteSpecial.xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
This will set the values equal to each other without copying/pasting.
Option Explicit
Sub Testing()
Dim wsC As Worksheet: Set wsC = ThisWorkbook.Sheets("Data")
Dim wsP As Worksheet: Set wsP = ThisWorkbook.Sheets("Print")
Dim LRow As Long
LRow = wsP.Range("B" & wsP.Rows.Count).End(xlUp).Offset(1).Row
wsP.Range("B" & LRow).Resize(wsC.Range("J11:Q11").Rows.Count, wsC.Range("J11:Q11").Columns.Count).Value = wsC.Range("J11:Q11").Value
End Sub
Modifying your code - and reducing to minimal example
Sub test()
Dim copySheet As Worksheet: Set copySheet = Worksheets("Data")
Dim pasteSheet As Worksheet: Set pasteSheet = Worksheets("Print")
copySheet.Range("J11:Q11").Copy
pasteSheet.Range("B" & pasteSheet.Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
End Sub
From what i can gather, you want to copy 8 cells and paste all 8 cells to 20 rows, starting at B4. You are not clear on how you want to rerun the macro, it will just write over the data you just pasted.
The first code will copy the 8 cells into the 20 rows
With ThisWorkbook
Sheets("Data").Range("J11:Q11").Copy
Sheets("Print").Range("B4:I23").PasteSpecial Paste:=xlPasteValues
End With
This second code uses a for loop to accoplish the same task, but it also will write over the previously pasted data.
Dim i As Long
With ThisWorkbook
For i = 4 To 23
Sheets("Data").Range("J11:Q11").Copy
Sheets("Print").Cells(i, 2).PasteSpecial Paste:=xlPasteValues
Next i
End With
If you want to be able to reuse the macro, you will have to modify the range to be copied that allows you to select the range you want to copy. Maybe a variable that allows a user input with a InputBox.
Edit:
Dim lRow As Long
lRow = Sheets("Print").Cells(Rows.Count, 2).End(xlUp).Row
With ThisWorkbook
Sheets("Data").Range("J11:Q11").Copy
Sheets("Print").Cells(lRow, 2).Offset(1).PasteSpecial Paste:=xlPasteValues
End With
Edit #3
With ThisWorkbook
Dim lRow As Long
lRow = .Sheets("Print").Range("B" & Rows.Count).End(xlUp).Row
Sheets("Data").Range("J11:Q11").Copy
Sheets("Print").Cells(lRow, 2).Offset(1).PasteSpecial Paste:=xlPasteValues
End With
I have an audit that is done daily. I have been asked to save the audit points to a separate sheet for review by the mgmt. team. The code is below but when I run it I get an error: Script out of range.
Sub copy1()
Dim sheet2 As Worksheet
Dim sheet10 As Worksheet
Set sheet2 = Worksheets("sheet2")
Set sheet10 = Worksheets("sheet10")
sheet2.Range("a2:g10").Copy
sheet10.Cells(Rows.count, 1).End(xlUp).Offset(1, 0).pastspecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
It's difficult to say for sure, but it is likely that you are receiving the "Subscript out of range" error because your workbook does not have the worksheets named "Sheet2" and "Sheet10".
The following code copies data from Sheet2 and pastes the values of the data to the next available row on Sheet10.
Sub Copy2()
Dim DestinationStartingCell As Range
Dim SheetRowCount As Long
Worksheets("Sheet2").Range("A2:I29").Copy
SheetRowCount = Worksheets("Sheet10").Rows.Count '1048576 for Excel 2007 and later
Set DestinationStartingCell = Worksheets("Sheet10") _
.Range("A" & SheetRowCount).End(xlUp).Offset(1, 0)
DestinationStartingCell.PasteSpecial xlPasteValues
End Sub
You could use this code
emptyrow=WorksheetFunction.CountA(Workbooks(<workbookname>).Sheets(10).Range("A:A"))+1
Workbooks(<workbookname>).Sheets(10).Cells(emptyrow,1).pastespecial xlPasteValues
to dynamically find the first empty row in Sheet10 to paste to.
I am designing a macro that will copy and sort data by a key in vba. I have begun to write the code and it has worked well so far but for some reason I get an Object Required error at the line : Set rng1 = SourceData.Cells.Range("A2:A" & N). I am unsure why this is happening. Any help would be greatly appreciated.
Sub crossUpdate()
Dim rng1 As Range, rng1Row As Range
N = Cells(Rows.Count, "A").End(xlUp).row
Sheet1.Cells.Select
Selection.Copy
Sheets.Add.Name = "SourceData"
ActiveSheet.Paste
Range("A1").Select
Set rng1 = SourceData.Cells.Range("A2:A" & N)
Set rng1Row = rng1.EntireRow
rng1Row.Sort Key1:=Range("A1")
End Sub
You are getting an error because SourceData is not a thing. It looks like that is supposed to be a worksheet or a range or something, but you have not declared it, nor have you set it.
Update: SourceData is a sheet. To refer to a sheet by name you should use Sheets("Sheetname"). Furthermore, there is no need to refer to the cells of the sheet to get a specific range in the sheet, just go right to the range: Sheets("SourceData").Range("A2:A" & N)
I am trying to select each consecutive cell in Row K (starting from Range K1), and for each cell going down, copy the value and paste it into Cell M10. However, the way the macro is written currently, the macro is selecting the cell right below the last cell in Range K, and is thus copying a blank into M10. Instead, I want the loop to work down one cell at a time. I want to select one cell at a time and copy it, i.e. the Loop will select K1 and copy it to M10, then select K2 and copy it to M10, etc, and then have the loop stop after the last cell of Range K.
Can anyone please help me out on this?
Sub test()
lastcell = Range("K" & Cells.Rows.Count).End(xlUp)
Range("K2").Select
Do
ActiveCell.Offset(1, 0).Select
Selection.Copy
Range("M10").Select
Selection.PasteSpecial
Application.Run ("Second Macro")
Loop Until IsEmpty(ActiveCell.Value)
End Sub
You can loop through column K using the small script below:
Option Explicit
Sub LoopThroughColumnK()
Dim LastRowInColK As Long, Counter As Long
Dim SourceCell As Range, DestCell As Range
Dim MySheet As Worksheet
'set references up-front
Set MySheet = ThisWorkbook.Worksheets("Sheet1")
With MySheet
LastRowInColK = .Range("K" & .Rows.Count).End(xlUp).Row
Set DestCell = .Range("M10")
End With
'loop through column K, copying from cells(counter, 11) to M10
With MySheet
For Counter = 1 To LastRowInColK
Set SourceCell = .Range("K" & Counter)
SourceCell.Copy Destination:=DestCell
'call MyMacro below
'... doing cool MyMacro stuff
Next Counter
End With
End Sub
To summarize what's happening, we:
Assign a worksheet variable to make sure we're working on the right sheet
Assign easy-to-read and reference variables for the last row and cell M10
Loop through the range in question, copying and pasting from Kn to M10
This technique also avoids using .Select, a common source of run-time errors. Here's an AMAZING post outlining lots of ways to NOT use .Select and .Activate: How to avoid using Select in Excel VBA macros
Edit: The refactoring I described in my comment above could be implemented without too much struggle. Let's break the whole problem into two bite-size chunks:
Get all the occupied cells in column K and save them as a Range
Running your secondary macro, which was keyed off cell M10, for each Cell in the Range we saved in step #1 above. We'll call the secondary macro MyOtherMacro for now
Let's get after it. Sunday Funday y'all! The code below is heavily-commented to explain what's happening in each function and step:
Option Explicit
Sub DoWork()
Dim MySheet As Worksheet
Dim ColKRange As Range
'set the worksheet we want to work on, in this case "Sheet1"
Set MySheet = ThisWorkbook.Worksheets("Sheet1")
'get the range of occupied cells in col K
Set ColKRange = OccupiedRangeInColK(MySheet)
'kick off the other macro using the range we got in the step above
Call MyOtherMacro(ColKRange)
End Sub
DoWork (above) is a "controller"-type script. All it does is kick off the other two functions we have written below, OccupiedRangeInColK and then, one step later, MyOtherMacro.
'this function returns a range object representing all
'the occupied cells in column K, starting at row 1 and ending
'at the last occupied row (in column K)
Public Function OccupiedRangeInColK(TargetSheet As Worksheet) As Range
Dim LastRow As Long
'check for unassigned worksheet object, return nothing if that's the case
If TargetSheet Is Nothing Then
Set OccupiedRangeInColK = Nothing
End If
With TargetSheet
LastRow = .Range("K" & .Rows.Count).End(xlUp).Row
Set OccupiedRangeInColK = .Range(.Cells(1, 11), .Cells(LastRow, 11))
End With
End Function
Cool -- descriptive names are a great thing when it comes to scripting. OccupiedRangeInColK (above) takes a Worksheet, then returns the occupied Range from column K.
'this function is a shell to be populated by #polymorphicicebeam
Public Function MyOtherMacro(TargetRange As Range)
Dim Cell As Range
'check for an empty range, exit the function if empty
If TargetRange Is Nothing Then Exit Function
'loop through all the cells in the passed-in range
For Each Cell In TargetRange
'Do cool stuff in here. For demo purposes, we'll just
'print the address of the cell to the screen
MsgBox (Cell.Address)
Next Cell
End Function
Finally, MyOtherMacro (above) is where you get to add your own magic. I built a "shell" function for you, which simply prints the address of the cell in question with a MsgBox. You can add your own logic where indicated inside the For Each Cell In TargetRange loop. Woo!
I have an Excel sheet that is updating daily. I am trying to automatically update a graph with the new data (1 row) that is added daily.
So far I have:
Sub UpdateGraphs()
Dim latestRow As Integer
Sheets("DailyJourneyProcessing").Select
Range("A500").Select
Do Until ActiveCell.Value = ""
If ActiveCell.Value <> "" Then
ActiveCell.Offset(1, 0).Select
End If
Loop
ActiveCell.Offset(-1, 0).Select
Application.CutCopyMode = False
ActiveCell.EntireRow.Copy
ActiveCell.Offset(1, 0).Select
ActiveCell.EntireRow.PasteSpecial (xlPasteAll)
Application.CutCopyMode = False
latestRow = ActiveCell.row
Dim str1 As String
Dim rng1 As Range
str1 = "=DailyJourneyProcessing!$F$180:$F$" & latestRow
Set rng1 = Range(str1)
Debug.Print "Got this far..."
Set ActiveChart.SeriesCollection(1).Values = Range(str1)
I know that this looks like I simply copy the previous row but the formula's included take car of the changes in data.
The Integer / row at the moment is around 520, so I want to do:
ActiveChart.SeriesCollection(1).Values = "=DailyJourneyProcessing!$F$180:$F$520"
Where the row number changes daily. This is one of about 20 range updates I need to automate, but once I have solved one the others should be the same.
I have tried everything I can find online, but nothing quite worked.
At the moment, I get a run-time error 91: Object or With block variable not set.
Any help would be appreciated.
There is actually no need for VBA to accomplish this. You will find the method in this link much easier to manage and maintain than VBA code. Also, its really best not to use VBA when you don't have to!
However, so that you can see a more efficient way to code what you were trying to do, I've offered the code below. It very well may need some tweaks to fit your actual data set.
Sub UpdateGraphs()
Dim wks As Worksheet, rng1 As Range
Dim latestRow As Long ' changed to long to handle rows over 32,000 (whatever number Integer stops at)
Set wks = Sheets("DailyJourneyProcessing")
With wks
latestRow = .Range("F" & .Rows.Count).End(xlUp).Row
str1 = "=DailyJourneyProcessing!$F$180:$F$" & latestRow
Set rng1 = Range(str1)
Dim myChart As Chart
Set myChart = .ChartObjects("myChartName")
myChart.SeriesCollection(1).Values = rng1
End With
End Sub