I found this macro and it does what I need it to do however whenever it's activated it seems to copy/paste the data multiple times. My master list should only have 75 or so lines and when this runs it ends up at 268. Why is it doing that? Also, is there a way to edit it so if a sheet has no data in it after "A1" it doesn't copy that sheet?
Option Explicit
Private Sub Worksheet_Activate()
'Merge all sheets in a workbook into one summary sheet (stacked)
Dim cs As Worksheet, ws As Worksheet, LR As Long, NR As Long
Application.ScreenUpdating = False
Set cs = Sheets("Master List")
cs.Activate
Range("A2:F" & Rows.Count).ClearContents
For Each ws In Worksheets
If ws.Name <> "Master List" Then
NR = cs.Range("A" & Rows.Count).End(xlUp).Row + 1
LR = ws.Range("A" & Rows.Count).End(xlUp).Row
ws.Range("A2:F" & LR).copy cs.Range("A" & NR)
End If
Next ws
Application.ScreenUpdating = True
End Sub
You have this in the Private Sub Worksheet_Activate() event of the workbook. If this is written into the "Master List" sheet's code, then activating the sheet as you do with line cs.activate will trigger the macro again... the one that is currently running. It's hard to say why this only creates 268 and not infinite, or double... it's tough to say and may be dependant on the speed at which excel works and it's single threadiness or some other deep down dark mystery of Excel and VBA.
Instead of
cs.activate
range("a2:f" & rows.count).clearcontents
try
cs.range("a2.f" & rows.count).clearcontents
If you find yourself writing .activate or .select in your vba code, you are probably doing something not-so-great.
Related
I have a workbook with various sheets named Alert* (each Alert sheet name have a different date on it) and client sheet. The time that I run code to Copy and Paste the information in 2 sheets named client I am facing an issue.
The Copying and Paste are working fine. However, it deletes the information in Range ("K16", "C1" & "C2") in all my sheets named Alert*. It is not a big problem, because I still can copy this information once again from the client sheet.
I am trying many ways to copy and paste code, and I can't make it work.
Dim sht As Worksheet
Dim sw As Worksheet: Set sw = Sheets("Client*")
For Each sht In Worksheets
If sht.Name Like "Alert*" Then
sht.Range("K16").Value = sw.range("J3")
sht.Range("C1").Value = sw.range("C1")
sht.Range("C2").Value = sw.range("C2")
End If
Next ws
I try
Dim sht As Worksheet
set sht = worksheets("Alert*)
ActiveSheet.Range("J3").Copy sht.Range("K16")
ActiveSheet.Range("C1:C2").Copy sht.Range("C1:C2")
But it is not working.
Maybe it would be possible to use a loop to check all the sheets named Alert* and paste the information from Client sheet to the correct range.
If we are to assume that you create a new worksheet named "Client Review" manually or by some other method not shown, I believe the below will help you achieve your desired outcome.
It will essentially look for a worksheet called "Client Review*" (let's called this Worksheet A), then copy the ranges from that worksheet to the "Client Review" (Worksheet B), and then it will delete A and rename B to have a date stamp on it, so when you re-run this another day when you have recreated the "Client Review" worksheet (i.e Worksheet A).
If all I said above makes sense, then you would have to ensure you update the formula for K16 once you have recreated the Client Review Worksheet.
I've added another loop similar to yours to ensure every worksheet named Client* does have the formula ("='" & ws.Name & "'!J3")
Sub CopyOldToNew()
Application.ScreenUpdating = False: Application.DisplayAlerts = False: Application.AskToUpdateLinks = False 'For less lag
Dim wsClientReview As Worksheet: Set wsClientReview = ThisWorkbook.Worksheets("Client Review")
Dim wsPreviousClientReview As Worksheet
Dim ws As Worksheet
On Error GoTo ErrorTrue
today = Format(Date, "MM.DD.YYYY")
For Each wsPreviousClientReview In ThisWorkbook.Worksheets
If wsPreviousClientReview.Name Like "Client Review*" And wsPreviousClientReview.Name <> "Client Review" Then
'wsPreviousClientReview.Activate
Exit For
End If
Next ws
wsPreviousClientReview.Range("A22:N250").Copy
wsClientReview.Range("A22:N250").Paste
wsClientReview.Range("J3").Value = wsPreviousClientReview.Range("J3").Value
wsClientReview.Range("G8:H12").Value = wsPreviousClientReview.Range("G8:H12").Value
wsClientReview.Name = "Client Review " & Format(Date, "mm.dd.yyyy")
ws.Delete
wsClientReview.Move before:=Thisworbkook.Sheets(1)
For Each ws In Worksheets
If ws.Name Like "Client*" Then
ws.Range("K16").Value = wsClientReview.Range("J3").Value
End If
Next ws
Application.ScreenUpdating = True: Application.DisplayAlerts = True: Application.AskToUpdateLinks = True
Exit Sub
ErrorTrue:
MsgBox "No manually added sheets identified."
Alert.Activate
Application.ScreenUpdating = True: Application.DisplayAlerts = True: Application.AskToUpdateLinks = True
End Sub
Total VBA noob here, so bear with me, please.
I have a workbook that has 67 columns, of which I only need the data of 14 columns pasted into a new worksheet and then is formatted into a table. This source workbook is updated daily with new rows of data that I would like to update the new worksheet and table with the update data.
My Current workflow is as follows:
Download Source Workbook with updates.
I copy the source workbook into MasterList, as is no modifications. I make sure to copy only rows and columns with data.
In the Master List Sheet I placed an Update button, so that it copies the columns I need from MasterList to MasterTable.
I found a solution that copies the data but it appears that it copies all of the rows whether they have data or not. Resulting in the new table having 100,000+ rows and really slowing down my excel app and hanging my system.
Here is the code that I am using to accomplish the copy and paste. I
Sub Button1_Click()
Worksheets("MasterList").Activate
Worksheets("MasterList").Range("I:I,J:J,K:K,L:L,M:M,N:N,S:S,X:X,Y:Y,Z:Z,AA:AA,AC:AC,AD:AD").Select
Selection.Copy
Worksheets("MasterTable").Activate
Worksheets("MasterTable").Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub
If hiding the unnecessary columns weren't so tedious every time I get a new update I could live with that set up, but I am hoping there is a faster more efficient way to accomplish this.
I appreciate any directions or suggestions.
Don't use .select or .activate. It is resource heavy / slow.
Tested and working.
Sub test()
' These will help with the speed of your macro.
' This turns of calculations
Application.Calculation = xlCalculationManual
' This runs the macro "behind the scenes"
Application.ScreenUpdating = False
' Always dim your variables
Dim lRow As Long
Dim wb As Workbook: Set wb = ThisWorkbook
Dim Sourcews As Worksheet: Set Sourcews = wb.Worksheets("MasterList")
Dim Destinationws As Worksheet: Set Destinationws = wb.Worksheets("MasterTable")
' find the last row of the source ws
lRow = Sourcews.Cells(Sourcews.Rows.Count, "I").End(xlUp).Row
' "select" from row 1 to the last row containing data and paste to the destination ws
Sourcews.Range("I1:N" & lRow & ", S1:S" & lRow & ", X1:AA" & lRow & ", AC1:AD" & lRow).Copy Destination:=Destinationws.Range("A1")
' turn the calculations and screen updating back on
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
My goal is to take an excel document with variable row size, copy it and then paste it onto the bottom row of a new document.
Longer story, I need to take monthly sales reports and stack them into a larger excel file. Each month we make a variable number of sales. I need to aggregate all of these months together so we can process them.
I have some code that I thought worked below. It was able to move variable rows within different work sheets, but could not do the same for different work books.
Private Sub MoveRowToEndOfTable()
Dim LastRow As Long
LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows,SearchDirection:=xlPrevious).Row
Sheets(1).Range("A2:A" & LastRow, "G2:G" & LastRow).Copy
Workbooks("BRN report Aggregator.xlsx").Worksheets("New shares EOM").Range("a6000").End(xlUp).Offset(1, 0).Cells.Insert
End Sub
I guess that your workbook is closed, check it before paste values (if workbook is closed ~> open it) :
Private Sub MoveRowToEndOfTable()
Dim LastRow As Long
LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Sheets(1).Range("A2:A" & LastRow, "G2:G" & LastRow).Copy
Dim wb As Workbook, wb_target As Workbook
'check if workbook is open already
For Each wb In Workbooks
If wb.Name = "BRN report Aggregator.xlsx" Then
Set wb_target = Workbooks("BRN report Aggregator.xlsx")
Exit For
End If
Next wb
'if not then open it
If wb_target Is Nothing Then
Set wb = Workbooks.Open("Path_to_file/BRN report Aggregator.xlsx")
End If
wb.Worksheets("New shares EOM").Range("a6000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll 'or xlPasteValues --depends on your needs
wb.Close True 'save and close if required
End Sub
Ignoring what my code actually does (it's not important to my question):
I want to be able to open my excel file, press a button, have the code use data in that workbook and another opened workbook (so I would have two workbooks opened at the same time, the macro runs in one of them but can take data from both of them).
The trick here is that I can't seem to find code to access the other workbook that I've opened up, so I can only take info from the active workbook.
For example,
Private Function GetLastRow() As Integer
Dim myLastRow As Integer
Set ws = ThisWorkbook.Sheets("Sheet1")
myLastRow = Range("C" & Rows.count).End(xlUp).Row
GetLastRow = myLastRow
End Function
This code lets me access the active workbook (the one running the code), using ThisWorkbook.
Is there another function capable of allowing me to access another opened workbook?
You could change your function to be more flexible.
Private Function GetLastRow(InWorksheet As Worksheet, InColumn As Variant) As Long
GetLastRow = InWorksheet.Cells(InWorksheet.Rows.Count, InColumn).End(xlUp).Row
End Function
So you can call it …
Sub Test()
Dim LastRow As Long
LastRow = GetLastRow(ThisWorkbook.Worksheet("Sheet1"), "C") 'column as letter
'or
'LastRow = GetLastRow(ThisWorkbook.Worksheet("Sheet1"), 3) 'column as number
End Sub
So you can even run this on another workbook using:
LastRow = GetLastRow(Workbooks("OtherWorkbook.xlsx").Worksheet("Sheet1"), "C") 'column as letter
There is a Workbook object built into VBA that you can use. This documentation should give you the information that you need https://learn.microsoft.com/en-us/office/vba/api/excel.workbook
You would simply put the name of your other workbook in quotes, in parentheses after using the Workbook object (see example on page I hyperlinked). Good luck!
I guess this is what you looking for.
When you have more then one Workbook active you can switch between then.
Sub GetLastRow()
Dim myLastRow As Integer
'Active Workbook
Set ws = ThisWorkbook.Sheets("Plan1")
myLastRow = ws.Range("C" & Rows.Count).End(xlUp).Row
MsgBox myLastRow
'Way when you know workbook name
Workbooks.Open Filename:=ActiveWorkbook.Path & "\Teste1.xlsx"
Set ws1 = Application.Workbooks("Teste1.xlsx").Sheets("Plan1")
myLastRow1 = ws1.Range("C" & Rows.Count).End(xlUp).Row
MsgBox myLastRow1
Dim myLastRow As Integer
'If you don't know the name but, opened after your main Workbook
Set ws3 = Application.Workbooks(2).Sheets("Plan1")
myLastRow3 = ws1.Range("C" & Rows.Count).End(xlUp).Row
MsgBox myLastRow3
End Sub
I have a CommandButton which opens a UserForm and create a copied Sheet with the name of the ComboBox Value.
This is My Code:
Private Sub CommandButton1_Click()
[UserForm1].Show ' Open UserForm
End Sub
Private Sub CommandButton2_Click()
Dim ws As Worksheet
ActiveWorkbook.Sheets("Sheet1").Visible = True ' Unhide Sheet
Sheets("Sheet1").Copy _
Before:=ActiveWorkbook.Sheets("Sheet1") ' Copy Sheet
Set ws = ActiveSheet
ws.Name = ComboBox1.Value ' Name Sheet
[UserForm1].Hide ' Close UserForm
ActiveWorkbook.Sheets("Sheet1").Visible = False ' Hide Sheet again
End sub
Now my problem is, if there are two machines with name "Machine Type 1" Excel gets an Error. So what do i have to change in my code, that the second sheet would named e.g. "Machine Type 1 (2)?
Thanks for your help.
you could try this
Private Sub CommandButton1_Click()
If IsSheetThere(ComboBox1.Value) Then 'if some sheet with chosen name already there
Sheets(ComboBox1.Value).Copy Before:=Sheets(10) ' copy the existing sheet
With ActiveSheet 'reference just copied sheet
.UsedRange.Clear 'clear its content
Sheets("Sheet1").UsedRange.Copy ActiveSheet.Range("A1") ' copy Sheet1 content and paste into it
End With
Else 'otherwise
Sheets("Sheet1").Copy Before:=Sheets(Sheets.Count) ' make a copy of "Sheet1" sheet
ActiveSheet.Name = ComboBox1.Value 'and rename it as per chosen name
End If
Me.Hide
End Sub
Function IsSheetThere(shtName As String) As Boolean
On Error Resume Next
IsSheetThere = Not Sheets(shtName) Is Nothing
End Function
the code line:
Sheets(ComboBox1.Value).Copy Before:=Sheets(10) ' copy the existing sheet
is the one that leaves Excel the burden of somehow "counting" the number of already existing sheets with the chosen name, and name the new one appropriately
You can use the following sub which calls the below function, just apply the same logic using .Copy
Sub create_new_sheet_with_name(name As String, wb As Workbook, aftersheet As Variant)
Dim i As Integer
i = 2
If sheet_name_exists(name, wb) Then
Do While sheet_name_exists(name & " (" & i & ")", wb)
i = i + 1
Loop
wb.Sheets.Add(after:=aftersheet).name = name & " (" & i & ")"
Else
wb.Sheets.Add(after:=aftersheet).name = name
End If
End Sub
Function sheet_name_exists(name As String, wb As Workbook) As Boolean
For Each sheet In wb.Worksheets
If sheet.name = name Then
sheet_name_exists = True
Exit Function
End If
Next sheet
sheet_name_exists = False
End Function
here's an example of how to use the sub:
Sub test()
create_new_sheet_with_name "hi", ThisWorkbook, ThisWorkbook.Sheets(1)
'this adds a new sheet named "hi" to thisworkbook after thisworkbook.sheets(1)
End Sub
Technically this isn't an answer to this question... but it's better because it will help you solve this and many other coding tasks on your own.
There is a simple way to create VBA code for most basic tasks.
If there's something Excel can do that you want to be able to do programmatically, just Record a Macro of yourself performing the action(s), and then look at the code that Excel generated.
I have a terrible memory, I can't remember commands I used yesterday. So it's not only quicker and less frustrating for others for me to figure it out myself, but the more often I do that, the quicker I'll learn (without asking others to do the thinking for me on a basic question).
I fact, I'm guess that the majority of veteran VBA coders learned at least partly by analyzing recorded macros. I know I did.