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
Related
For a small project i want to use a vlookup or match in VBA to derive data from another sheet. I found it a difficult task even with the help of google I couldn't find the solution.
I divided the project into 3 phases:
First phase is creating a working Vlookup in VBA (can't get it working)
Search for the range where it needs to be executed (dynamic) (I think I managed)
Loop through all the cells in the table (totally stuck on "For each" statement)
I managed to fetch the dynamic range #Firstcell and #Lastcell
But I'm really stuck at the loop and vlookup.
I want to create the vlookup in such way that for each cell the X will be A & rownumber and Y will be Columnletter & "4".
The vlookup needs to be executed from Firstcell to Lastcell.
Sub Match_Values()
' Variables
Dim X As Integer
Dim Y As Integer
Dim Firstcell As Integer
Dim Lastcell As Integer
' Range determination
With ActiveSheet
Range("A3").Select
Selection.End(xlToRight).Select
Firstcell = ActiveCell.Offset(1, 1).Range("A1").Select
End With
With ActiveSheet
Lastcell = ActiveCell.SpecialCells(xlLastCell).Select
End With
' For each cell create a vlookup with on rowindex en on y the columnindex loop statement
' Vlookup
With WorksheetFunction
c04 = .VLookup(X, [Pivot!A4:CC99], .Match(Y, [Sheet1!A4:CC4], 0), False)
End With
MsgBox c04
End Sub
Thanks in advance, if i need to provide additional feedback please let me know.
Edit, Thanks for the feedback
I uploaded the example file: https://ufile.io/48evu
(i'm sorry didn't see how to disclose in stackoverflow)
Picture 1
Picture 2
I found a way that made my script work.
I agree with Peh that I should look more into VBA, but it works.
Maybe this could be useful for someone that try's something similar and it makes the question answered.
Thanks for the support!
Private Sub Match_Values()
' Variables
Dim Firstcell As String
Dim Lastcell As String
Dim sht As Worksheet
' Range determination
With ActiveSheet
Range("A3").Select
Selection.End(xlToRight).Select
ActiveCell.Offset(1, 1).Range("A1").Select
Firstcell = ActiveCell.Address
End With
With ActiveSheet
ActiveCell.SpecialCells(xlLastCell).Select
Lastcell = ActiveCell.Address
End With
Dim rng As Range: Set rng = Application.Range("Overview!" & Firstcell & ":" & Lastcell)
Dim cel As Range
For Each cel In rng.Cells
cel.FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC1,Pivot!R4C1:R100C50,MATCH(Overview!R2C,Pivot!R4C1:R4C50,0),FALSE),""Error"")"
Next cel
End Sub
Greetings!
I know this has been asked lot of times but I'm having a trouble with VBA, I am very new to VBA.
I'm working with a single workbook that has a working worksheet. basically I need to sort the Currency column, currently have 14 currencies, I need loop through it (since currency may add through time depending on the customer) then copy the row with the criteria paste it to another sheet with its cell value.
my code below.
Option Explicit
Sub SortCurrency()
Dim rng As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
I = Worksheets("Sheet1").UsedRange.Rows.Count
J = Worksheets("Sheet2").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
End If
Set rng = Worksheets("Sheet1").Range("AB2:AB" & I)
On Error Resume Next
Application.ScreenUpdating = False
For Each xCell In rng
If CStr(xCell.Value) = "USD" Then
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = xCell.Value
xCell.EntireRow.Copy Destination:=Sheets(Sheets.Count).Name = xCell.Value.Range("A" & J + 1)
'Sheets.Add After:=Sheets(Sheets.Count)
'Sheets(Sheets.Count).Name = xCell.Value
Application.CutCopyMode = False
J = J + 1
End If
Next
Application.ScreenUpdating = True
End Sub
I basically got the codes from my research, add them up and not coming into the way I wanted. I wanted to keep the header and the values with criteria,
i,e currency column "AB" is USD as per example above, but the problem is it'll be a lot of coding because I have to go through all 14 currencies plus if there will be new currency that will be added,
also I know there is a way of not declaring multiple sheets and just having another new worksheet with the cell value name but I'm having a problem getting it done all at once. if there will be a simpler and powerful code. I am greatly thankful.
you may want to try this code, exploiting Autofilter() method of Range object
Option Explicit
Sub SortCurrency()
Dim currRng As Range, dataRng As Range, currCell As Range
With Worksheets("Currencies") '<--| change "Currencies" to your actual worksheet name to filter data in and paste from
Set currRng = .Range("AB1", .Cells(.Rows.Count, "AB").End(xlUp))
Set dataRng = Intersect(.UsedRange, currRng.EntireRow)
With .UsedRange
With .Resize(1, 1).Offset(, .Columns.Count)
With .Resize(currRng.Rows.Count)
.Value = currRng.Value
.RemoveDuplicates Array(1), Header:=xlYes
For Each currCell In .SpecialCells(xlCellTypeConstants)
currRng.AutoFilter field:=1, Criteria1:=currCell.Value
If Application.WorksheetFunction.Subtotal(103, currRng) - 1 > 0 Then
dataRng.SpecialCells(xlCellTypeVisible).Copy Destination:=GetOrCreateWorksheet(currCell.Value).Range("A1")
End If
Next currCell
.ClearContents
End With
End With
End With
.AutoFilterMode = False
End With
End Sub
Function GetOrCreateWorksheet(shtName As String) As Worksheet
On Error Resume Next
Set GetOrCreateWorksheet = Worksheets(shtName)
If GetOrCreateWorksheet Is Nothing Then
Set GetOrCreateWorksheet = Worksheets.Add(After:=Sheets(Sheets.Count))
GetOrCreateWorksheet.name = shtName
End If
End Function
You're pretty close with what you've got, but there's a few things to note:
On Error Resume Next is normally a bad plan as it can hide a whole lot of sins. I use it in the code below, but only because I immediately deal with any error that might have happened.
xCell.Value.Range("A" & J + 1) makes no sense. Chop out the middle of that line to leave xCell.EntireRow.Copy Destination:=Sheets(Sheets.Count).Range("A" & J + 1)
Rather than checking if the value is a specific currency, you should be taking the value, whatever currency it is, and dealing with it appropriately.
Using J as a counter works for one currency, but when dealing with multiple, it'll be easier to just check where it should go on the fly.
All told, the below code should be close to what you're looking for.
Option Explicit
Sub SortCurrency()
Dim rng As Range
Dim xCell As Range
Dim targetSheet As Worksheet
Dim I As Long
Dim J As Long
I = Worksheets("Sheet1").UsedRange.Rows.Count
J = Worksheets("Sheet2").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
End If
Set rng = Worksheets("Sheet1").Range("AB2:AB" & I)
Application.ScreenUpdating = False
For Each xCell In rng
Set targetSheet = Nothing
On Error Resume Next
Set targetSheet = Sheets(xCell.Value)
On Error GoTo 0
If targetSheet Is Nothing Then
Sheets.Add After:=Sheets(Sheets.Count)
Set targetSheet = Sheets(Sheets.Count)
targetSheet.Name = xCell.Value
xCell.EntireRow.Copy Destination:=targetSheet.Range("A" & J + 1)
Else
xCell.EntireRow.Copy Destination:=targetSheet.Range("A" & targetSheet.Range("A" & Rows.Count).End(xlUp).Row + 1)
End If
Application.CutCopyMode = False
Next
Application.ScreenUpdating = True
End Sub
OK, there's quite a lot going on here... I'm going to try and tackle one problem at a time.
1 - You could do with testing whether a worksheet already exists rather than creating it every time
Assuming you want to do something for each and every currency in your loop, I would suggest not using the if condition you're using at the moment, "if value = "USD"", and instead use the cell value to determine the name of the sheet, whatever the cell value is.
First of all you need a seperate function to test whether the sheet exists, like
Public Function DoesSheetExist(SheetName as String)
On Error Resume Next
Dim WkSheet as WorkSheet
'sets worksheet to be the sheet NAMED the current currency name
Set WkSheet = Sheets(SheetName)
'because of on error resume next, WkSheet will simply be "Nothing" if no such sheet exists
If WkSheet is Nothing Then
DoesSheetExist = False
Else
DoesSheetExist = True
End If
End Function
You can then call this function in your code, and only create new sheets when you need to
2 - The loop itself
So instead, I would suggest your loop probably wants to look more like this:
Dim xSheet as Worksheet 'declare this outside the loop
For Each xCell In rng
If DoesSheetExist(xCell.Value) Then
set xSheet = Sheets(xCell.Value) 'this is the code for if the sheet does exist - sets the sheet by the sheet name rather than index
Else
set xSheet = Sheets.Add After:=Sheets(Sheets.Count)
xSheet.Name = xCell.Value
End if
With this setup, for every currency your loop will either set xSheet to the currency sheet that already exists, or create that sheet. This assumes that you want to do the same thing to all currencies, if not then extra conditions will need adding in
3 - the copy/paste line itself
xCell.EntireRow.Copy Destination:=Sheets(Sheets.Count).Name = xCell.Value.Range("A" & J + 1)
I don't think this code says what you think it does - what this code actually says is "Copy the Entire Row to the last Sheet's name, and make it equal to the range within xCell's Value at A, (J)+1
I think what you actually wanted to say was this:
xCell.EntireRow.Copy Destination:=Sheets(Sheets.Count).Range("A" & J + 1)
However, if you're using the code I gave you above you can instead use this now:
xCell.EntireRow.Copy Destination:=xSheet.Range("A" & J + 1)
In fact, you'd be better off doing that, especially if there is a chance that the sheets already existed and were picked up by DoesSheetExist
Personally I would also rather transfer values over than use copy/paste any day, but that's just an efficiency thing, the above should function fine.
I have code which nicely copies data from multiple sheets in a workbook to a summary sheet and the variable number of sheets have always contained data in exactly the same format.
The input files now have a variable number of columns (roughly 50% exactly the same and 50% variable) and I now need to extend the code so that the sheet name is added to the data copied to the summary sheet. I can then copy the fixed-format data onto the summary sheet and use part of that, along with the sheet name, to reference the variable data and copy it into the necessary column.
The current code is below and I would be grateful if someone could assist with adding a column and the sheet name. Copying the variable data in once I have the sheet name will be straightforward.
Sub CopyData()
Application.ScreenUpdating = False
Dim wsSummary As Worksheet
Dim LastRow As Long
Dim LastRow2 As Long
Set wsSummary = Worksheets("Summary")
LastRow = wsSummary.Cells(Rows.Count, "A").End(xlUp).Row
wsSummary.Range("A2:R" & LastRow).Clear
ShtCount = ActiveWorkbook.Sheets.Count
For i = 2 To ShtCount
Worksheets(i).Activate
LastRow2 = activesheet.Cells(Rows.Count, "A").End(xlUp).Row
Range("A2:R" & LastRow2).Select
Selection.Copy
Sheets("Summary").Activate
LastRow2 = activesheet.Cells(Rows.Count, "A").End(xlUp).Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(0, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Next i
End Sub
Thanks
I've refactored the code a little to make it a bit better - Here's how it works:
Sub CopyData()
Application.ScreenUpdating = False
Dim wsSummary As Worksheet
Dim LastRowWs As Long
Dim LastRowSummary As Long
Dim StartRowSummary As Long
Set wsSummary = ThisWorkbook.Worksheets("Summary")
LastRowSummary = wsSummary.Cells(wsSummary.Rows.Count, "A").End(xlUp).Row + 1
wsSummary.Range("A2:R" & LastRowSummary).Clear
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Summary" Then
LastRowWs = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
StartRowSummary = wsSummary.Cells(wsSummary.Rows.Count, "A").End(xlUp).Row + 1 'first empty row
ws.Range("A2:R" & LastRowWs).Copy Destination:=wsSummary.Range("A" & StartRowSummary)
LastRowSummary = wsSummary.Cells(wsSummary.Rows.Count, "A").End(xlUp).Row
wsSummary.Range("S" & StartRowSummary & ":S" & LastRowSummary) = ws.Name
End If
Next
Application.ScreenUpdating = True
End Sub
As you can see it's fairly similar initially, but I have stripped out all the .Select, .Activate etc commands as they're not needed and can slow down a script during execution. I've also fully qualified all worksheet references to make sure we always know what part of the workbook we're referring to.
LastRowSummary is set initially to the last row plus 1. This is simply to ensure that if you only have headers in the summary sheet, you won't delete those.
The For Each loop allows us to iterate for every worksheet ws in the workbook.
We don't want to extract data from "Summary" so don't carry out the commands for that sheet.
Find the last row in the A column from whatever worksheet we're on, and detect where on the Summary sheet it's going to start from (important when we're going to be setting the worksheet name later on).
Copy the range from one worksheet to the other. Now get the updated last row for the Summary sheet as this tells us how many rows we need to tag for the worksheet name we copied from.
Since we have a handy reference to the worksheet in ws, we can just set column S to the ws.Name, using the start and end rows we detected earlier to ensure the name is set on all the rows (I've used column S because you only seemed to be copying A to R; S is just the next column; adjust as required for where you want the worksheet name to go).
And finally, remember to switch the Application.ScreenUpdating back on. Though since this version doesn't use the .Select or .Activate, you won't be flicking between sheets and so you could just drop both the False and True setting of this property without any negative result.
Let me know if you need any further explanation?
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
I'm working on copying large amounts of data from one spreadsheet to the other 160 spreadsheets in the workbook. Currently, Excel (2013) runs into an error as it does not have enough resources to complete the operation.
My goal is to copy data in the range V13:XI1150 in sheet 4 to sheets 5-160. I tried splitting up the range that the code is stored in (see variables rng1 and rng2), as well as grouping 10 worksheets together (although I realize this has little effect).
Is there a way to streamline the code I'm working on here so I can successfully copy this data over?
Thanks in advance.
Sub copypaste()
'''''''''Globals'''''''''''''
Dim j As Long 'Loop control variable
Dim sheetstart As Integer 'starting sheet variable
Dim sheetend As Integer 'ending sheet variable
Dim rng1 As Range 'range to copy
Dim rng2 As Range 'Second range
Application.Calculation = xlCalculationManual 'Sets manual calculation
Application.ScreenUpdating = False 'Turns off screen updating
sheetstart = 5 'first sheet to copy over in loop
sheetend = 15 'last sheeet to copy over in loop
With Sheets(4) 'Selects the 4th sheet
Set rng1 = Range("V13:LO1150") 'Stores first half of data in rng
Set rng2 = Range("LP13:XI1150") 'Stores second half of data in rng
End With
For j = 1 To 16 'loops through all groups of 10 sheets
copypaste10 rng1, sheetstart, sheetend 'calls copypaste10 function
copypaste10 rng2, sheetstart, sheetend 'calls copypaste10 function
sheetstart = sheetstart + 10 'increments to next 10 sheets
sheetend = sheetend + 10 'increments to next 10 sheets
Next
Application.Calculation = xlCalculationAutomatic 'Sets auto calculation
Application.ScreenUpdating = True 'Turns on screen updating
End Sub
Public Function copypaste10(rng As Range, sstart As Integer, sstop As Integer)
'''''''''Locals'''''''''''''
Dim i As Long 'Loop control
Dim WS As Worksheet 'worksheet being worked on
Dim ArrayOne() As String 'Array of sheets we are working on
ReDim ArrayOne(sstart To sstop) 'Array of sheets
''''''''''Calcuations'''''''''''''
For i = sstart To sstop
ArrayOne(i) = Sheets(i).Name
Next
For Each WS In Sheets(ArrayOne)
WS.Rows(2).Resize(rng.Count).Copy
rng.Copy Destination:=WS.Range("v13")
Next WS
End Function
I ran a quick test with the following code, and it ran just fine:
Sub test()
Application.ScreenUpdating = False
Dim rng As Range
Set rng = Worksheets("Sheet1").Range("V13:XI1150")
rng.Copy
For i = 2 To 161
Sheets(i).Select
Range("V13").Select
ActiveSheet.Paste
Next
Application.ScreenUpdating = True
End Sub
There was only static data in my test cells, not formulas. That may make the difference, because when you turn Automatic Calculation back on, that will be a gigantic hit to your system resources, especially if it is a complex calculation in your cells.
It could be extra Copy that you're doing in your loop i.e.
WS.Rows(2).Resize(rng.Count).Copy
That copy will store to memory even though you don't seem to be pasting it anywhere (to be honest though, I'm not sure whether or not that i.e. the clipboard will clear that after exiting the function or as needed)
Nonetheless, this is an alternate solution if you don't have formulas in your range origin.
Since your destination is always the same, and your origin ranges are the same dimension (just different starting points), you can avoid the copy / paste all together :
For Each WS In Sheets(ArrayOne)
WS.Range("V13:LO1150") = rng.Value
Next WS
Again, note that it will only copy the values over to your destination sheets
*--EDIT--*
If you do need the formulas you can change .Value to .Formula, but note that this will "paste" formulas that refer to the origin sheet, not the relative references of your destination sheet. I would also turn auto calculations off before running the macro (Application.Calculation = xlCalculationManual, and either calculate or turn on calculations at the end (Application.Calculation =xlCalculationAutomatic) or maybe after every few "pastes" by using Application.Calculate.