Ok Hi everybody,
I've been looking into this and trying to figure it out for a couple days now. I've found things close but nothing matches what I need.
I have 13 departments here and each department has a sheet with issues that need to be resolved. What I need is when each of those departments updates their excel sheet with an issue it updates on the master list (which is in the same workbook). Since people are constantly deleting and adding the formula would need to stay.
Would it be easier to have them enter the data on the master sheet and have that go into the individual files? If so how would I even do that? Thanks in advance. I'm trying to see if an advance filter or something would work but can't get it just right.
You will need to adjust the names in my code but if you paste this code in each of your department sheets (not the master list) you should get your desired result:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
Dim xlws As Excel.Worksheet
Set xlws = ActiveSheet
For i = 1 To 13
If IsEmpty(xlws.Cells(2, i).Value) = True Then
Exit Sub
End If
Next
Dim xlwsMaster As Excel.Worksheet
Set xlwsMaster = ActiveWorkbook.Worksheets("master list")
i = 1
Do While IsEmpty(xlwsMaster.Range("A" & i).Value) = False
i = i + 1
Loop
xlws.Range("A2:M2").Copy
xlwsMaster.Range("A" & i).PasteSpecial xlPasteAll
xlws.Range("A2:M2").Clear
End Sub
every time there is a change on one of those sheets it will check to see if all the values of a through m are filled if they are it copies a2:m2 and pastes it at the first empty row on the master list and then clears a2:m2 on the sheet in question
Related
Use case: I want to copy data from column A to Column B (where column A, B are arbitrary columns). Once the data is in Column B, I want to remove duplicate entries within column B.
Make a loop that moves data from column A to column B and then removes duplicates for each sheet in a workbook.
`Sub Copy()
For i = 1 To Sheets.Count
Worksheets(i).Range("A1:A100")
Destination:=Worksheets(i).Range("B1")
Next
End Sub
`
For testing I separated the tasks into two different Sub(). Sub Copy() is working and correctly copies my data. Sheet1 is also named "Sheet1" for my specific workbook
`Sub RemoveStuff()
Dim rng As Range
For j = 1 To Sheets.Count
Set rng = Worksheets("Sheet1").Range(Range("B1"),Range("B1").End(xlDown)).Select
rng.RemoveDuplicates Columns:=(1), Header:=xlGuess
Next
End Sub
`
My error seems to be in defining the range correctly. Each sheet will have a different number of entries to remove duplicates from. Sheet1 might have 50 rows and reduce to 6. Sheet2 could have 70 and reduce to 3. Sheet3 could have 20 rows and reduce to 12 uniques. Excel does not let you remove duplicates from range (B:B!)
How can I properly define my range so I can remove duplicates in a loop for a dynamically defined range for each sheet(sheet=tabs in workbook)?
EDIT 2-23-17
New code from Y0wE3K
Sub RemoveStuff()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Columns("P:P").RemoveDuplicates,Columns:=1, Header:=xlYes
Next
End Sub
Still does not work. If I manually select Column P before I run the macro, it works. But it only goes for the one sheet I have selected, it does not seem to execute the loop. Definitely does not automatically do each sheet, or prompt me for each one.
EDIT: 3/4
Make sure that you do not have any protected data, I also experienced issues with pivot tables but I think this may be permissions thank you for help.
Your RemoveStuff subroutine can be rewritten as:
Sub RemoveStuff()
Dim ws As Worksheet
For Each ws In Worksheets ' Use Worksheets instead of Sheets,
' in case there are any Charts
'You can just select the whole column, rather than selecting
'specific rows
ws.Columns("B:B").RemoveDuplicates Columns:=1, Header:=xlGuess
Next
End Sub
Sub RemoveStuff()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Columns("P:P").RemoveDuplicates,Columns:=1, Header:=xlYes
Next
End Sub
This code will work. As a final note, please make sure you have no Protected Data, or pivot tables inside of the sheets you need to run the remove script on. For whatever reason that caused mine to fail, but running my script on the correct sheets that are unprotected worked GREAT.
I would need a code that would allow me to copy and paste the information based on the matching IDs. The problem is that the number of rows that both my sheets has is more than 200000 rows with IDs on each rows. Some of the IDs are repeated in sheet 2. I only manage to create a code but it seems to be running and then it crash. Sheet 2 consist of all the information while Sheet 1 is where the information will be pasted when the IDs from both sheets matched.
This is the code that i have so far. I really hope anyone could help me with this as this code seems to keep running and crash and my VBA skills is very limited,
Sub AAA()
Dim tracker As Worksheet
Dim master As Worksheet
Dim cell As Range
Dim cellFound As Range
Dim OutPut As Integer
Set tracker = Workbooks("test.xlsm").Sheets("Sheet1")
Set master = Workbooks("test.xlsm").Sheets("Sheet2")
For Each cell In master.Range("A2:A100000")
' Try to find this value in the source sheet
Set cellFound = tracker.Range("A5:A100000").Find(What:=cell.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not cellFound Is Nothing Then
' A matching value was found
' So copy the cell 2 columns across to the cell adjacent to matching value
' Do a "normal" copy & paste
cellFound.Offset(ColumnOffset:=2).Value2 = cell.Offset(ColumnOffset:=2).Value2
' Or do a copy & paste special values
'cell.Offset(ColumnOffset:=2).Copy
'cellFound.Offset(ColumnOffset:=1).PasteSpecial xlPasteValues
Else
' The value in this cell does not exist in the source
' Should anything be done?
End If
Next
OutPut = MsgBox("Update over!", vbOKOnly, "Update Status")
End Sub
I had the same problem and was able to resolve it by deallocating the variable cellFound before re-assigning it. So, I suggest that you add:
Set cellFound = Nothing
right after the End If.
Hope that helps.
Hope you are all doing well. Im here because of a question Im trying to solve since this morning and I CANT stand it anymore.
That is the context : I have an excel workbook in which I have different sheets containing different business plans for different countries. My goal is to make a consolidated Income statement with the sum of the criteria (COGS, Net profit, Salaries....) in each sell.
Each cell in the A column corresponds to a criterion and I want the numbers to appear in the B column (Total of all companies for each criterion).
Thats my code : Initially it wasnt like this but thats one of my attempting drafts let me explain below why Im trying this format
Private Sub Consolidated_Income_Statement()
Dim Sheet As Worksheet
Dim Consolidated As Worksheet
For Each Sheet In Sheets
Do While Cells(B2, B152) <> ""
Consolidated = Sum(Call BPs, B152)
GoTo Consolidated
Next
End Sub
Sub BPs()
Dim Sheet As Worksheet
For Each Sheet In Sheets
If Right(Sheet.Name, 50) = "E2016" Then
End Sub
The fact is that I want to sum the cells only of the sheets containing "E2016" and Im trying to create a call button to use it my private sub once I have determined that I only want these E2016 sheets.
And thats how I tried to do it initially
Private Sub Consolidated_Income_Statement()
Dim Sheet As Worksheet
Dim Consolidated As Worksheet
For Each Sheet In Sheets
If Right(Sheet.Name, 50) = "E2016" Then
Do While Cells(B2, B152) <> ""
Consolidated = Sum('I WANT TO SELECT MY E2016, B152)
GoTo Consolidated
Next
End Sub
But nothing is working ! Sorry if these questions are too basic but Im learning VBA on my own for my company since 2 days and Im facing a couple of difficulties ! Thank you very much for your help !
Some thing like below?
Private Sub Consolidated_Income_Statement()
Dim Sheet As Worksheet
Dim Consolidated As Integer
For Each Sheet In Sheets
If Right(Sheet.Name, 5) = "E2016" Then
Consolidated = Consolidated + Application.WorksheetFunction.Sum(Sheet.Range("B2:B152"))
End If
Next
MsgBox "Sum is : " & Consolidated
End Sub
I have different workbooks with different sheets with same Sheet name.(Book1,Book2,Book3,excel1,excel2,micorsoft etc) in a folder.
I would like to create way to have the entire row (when data is entered) transfered to a summary workbook with the matching value in a cell.please see the example table below.
If you notice the example below,I have a Book1 with worksheet1 (it also have different worksheets along with this one).
Now my requirement is to copy entire row with matching status column cell or cells (eg: NEW,research) into the workbook where macro is running,from all the workbooks in a folder.
I request if some one can help me with this macro that will be great.
Note:
Not always but Some times this data would change from time to time, so it would have to keep over-writing with the most up to date data. I would just like it all to consolidate onto 1 workbook so I can have the data from there.
Is this something that can be done easily? I've tried my luck at some macros but I can't seem to get it.
Book1
Worrksheet1
column A column B column C status comment column D
Update
New
Modified
New
New
Research
Research
I was lucky enough to get a code to copy from one sheet to other in a single book the code is below
Code:
Sub Foo()
Dim i As Long, iMatches As Long
Dim aTokens() As String: aTokens = Split("New,research", ",")
For Each cell In Sheets("Worrksheet1").Range("E:E")
If (Len(cell.Value) = 0) Then Exit For
For i = 0 To UBound(aTokens)
If InStr(1, cell.Value, aTokens(i), vbTextCompare) Then
iMatches = (iMatches + 1)
Sheets("Worrksheet1").Rows(cell.Row).Copy Sheets("final").Rows(iMatches)
End If
Next
Next
End Sub
Description:
This code will copy ALL rows content with the words matching NEW,research or any required in the column E : E from Worrksheet1 sheet to final sheet
Now change required in this is to copy from different workbooks in a folder(given path to directory) into single workbook in same or differ folder.
If i can have an option to email the copy like mentioned below link
will be great
Creating a Windows application which reads and writes excel spreadsheets + reads and writes emails
I'm not entirely sure I understand what you're after...But.
Open all the workbooks that you want copied.
Paste the following code into a standard module in one of the workbooks (it doesn't matter which one) Run it.
The code creates a new workbook and looks at every cell in row 1 of every workbook in every worksheet. (apart from the one that's just been created)
If it isn't blank it copies the entire column into the new workbook in the same worksheet number and in the same column position. Cheers.
Sub alltoone()
Application.ScreenUpdating = False
j = 0
ght = 0
Set nwrk = Workbooks.Add
For i = 1 To Workbooks.Count - 1
ght = Application.WorksheetFunction.Max(ght, Workbooks(i).Worksheets.Count)
Next i
If ght > nwrk.Worksheets.Count Then
Do
nwrk.Worksheets.Add
Loop Until ght = nwrk.Worksheets.Count
End If
For i = 1 To Workbooks.Count - 1
For k = 1 To Workbooks(i).Worksheets.Count
For t = 1 To 256
Set fez = Workbooks(i).Worksheets(k).Cells(1, t)
If Not fez.Value = Empty Then
fez.EntireColumn.Copy
nwrk.Worksheets(k).Columns(t).EntireColumn.PasteSpecial
End If
Next t
Next k
Next i
Set nwrk = Nothing
Set fez = Nothing
Application.ScreenUpdating = True
End Sub
Could someone please help me with some VBA code.
I am trying to copy 2 ranges of cells between workbooks (both workbooks should be created beforehand as i don't want the code to create a new workbook on the fly).
Firstly I need to copy these ranges-
From 'Sheet 3' of booka.xls, Range: Cell H5 to the last row in column H with data
copy this to 'Sheet 1' of bookb.xls, starting in Cell B2 for as many cells down in the B column
Secondly I need to copy these ranges-
From 'Sheet 3' of booka.xls, Range: Cell K5 to the last row in column K with data
copy this to 'Sheet 1' of bookb.xls, starting in Cell D2 for as many cells down in the D column
Here is what I have so far:
Sub CopyDataBetweenBooks()
Dim iRow As Long
Dim wksFr As Worksheet
Dim wksTo As Worksheet
wksFr = "C:\booka.xls"
wksTo = "C:\bookb.xls"
Set wksFrom = Workbooks(wksFr).Worksheets("Sheet 3")
Set wksTo = Workbooks(wksTo).Worksheets("Sheet 1")
With wksFrom
For iRow = 1 To 100
.Range(.Cells(iRow, 8), .Cells(iRow, 9)).Copy wksTo.Cells(iRow, 8)
Next iRow
End With
End Sub
Assuming you have the reference to wksFrom and wksTo, here is what the code should be
wksFrom.Range(wksFrom.Range("H5"), wksFrom.Range("H5").End(xlDown)).Copy wksTo.Range("B2")
wksFrom.Range(wksFrom.Range("K5"), wksFrom.Range("K5").End(xlDown)).Copy wksTo.Range("D2")
Here's an example of how to do one of the columns:
Option Explicit
Sub CopyCells()
Dim wkbkorigin As Workbook
Dim wkbkdestination As Workbook
Dim originsheet As Worksheet
Dim destsheet As Worksheet
Dim lastrow As Integer
Set wkbkorigin = Workbooks.Open("booka.xlsm")
Set wkbkdestination = Workbooks.Open("bookb.xlsm")
Set originsheet = wkbkorigin.Worksheets("Sheet3")
Set destsheet = wkbkdestination.Worksheets("Sheet1")
lastrow = originsheet.Range("H5").End(xlDown).Row
originsheet.Range("H5:H" & lastrow).Copy 'I corrected the ranges, as I had the src
destsheet.Range("B2:B" & (2 + lastrow)).PasteSpecial 'and destination ranges reversed
End Sub
As you have stated in the comments, this code above will not work for ranges with spaces, so substitute in the code below for the lastrow line:
lastrow = originsheet.range("H65536").End(xlUp).Row
Now ideally, you could make this into a subroutine that took in an origin workbook name, worksheet name/number, and range, as well as a destination workbook name, worksheet name/number, and range. Then you wouldn't have to repeat some of the code.
You can use special cells like Jonsca has suggested. However, I usually just loop through the cells. I find it gives me more control over what exactly I am copying. There is a very small effect on performance. However, I feel that in the office place, making sure the data is accurate and complete is the priority. I wrote a response to a question similar to this one that can be found here:
StackOverflow - Copying Cells in VBA for Beginners
There is also a small demonstration by iDevelop on how to use special cells for the same purpose. I think that it will help you. Good luck!
Update
In response to...
good start but it doesn't copy anything after the first blank cell – trunks Jun 9 '11 at 5:08
I just wanted to add that the tutorial in the link above will address the issue brought up in your comment. Instead of using the .End(xlDown) method, loop through the cells until you reach the last row, which you retrieve using .UsedRange.Rows.Count.