Data copy to 2 different sheets depending on cell value - excel

I have 2 main sheets ( "kids" and "parents") and another 3 sheets that I use for data input. What I want the code to do is to copy the values of the 3 sheets from column A TO L and transfer them to the main sheets depending on the value chosen in column D. So if I insert data to one of the 3 sheets and I have as a value in column D "kids" it should transfer it to SHEET "KIDS" if I choose value "parents" the data should go to sheet "parents". In any case, I do want it to remove duplicates and not copy the same data each time I open the file.
Private Sub Workbook_Open()
Dim i As Long, lastRow As Long, ws As Worksheet
Sheets("Kids").Range("A3:L500").ClearContents
For Each ws In Worksheets
If ws.Name <> ("Kids") Then
ws.Activate
lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lastRow
If ws.Cells(i, "D").Value = "Kids" Then
Rows(i).Copy Destination:=Sheets("Kids").Range("A" & Rows.Count).End(xlUp).Offset(1)
ElseIf ws.Cells(i, "D").Value = "Parents" Then
Rows(i).Copy Destination:=Sheets("Parents").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If
Next i
End If
Next ws
End Sub
So this is the code I have used but it doesn't remove duplicates for main sheet "parents". Something is wrong...

Your question is not conveying total situation of your problem as mentioned by #Nicolas. However to help you with your problem go to the code posted by #fbonetti in the following thread to remove duplicates.
[delete-all-duplicate-rows-excel-vba:]Delete all duplicate rows Excel vba
Further to transfer Copy Data to Another Excel WorkBook Based on Criteria Using VBA to do is the following:
1. Identify data in a workbook sheet based on a text criterium and a date criterium or condition using a looping process
2. Select the specific data which meets the two or multiple conditions
3. Copy the identified data
4. Open another workbook
5. Find the first blank row in a specific worksheet in the workbook
6. Paste the data in the identified blank or empty row – erow
7. Save the workbook
8. Close the workbook
Go through the link mentioned below.
http://www.exceltrainingvideos.com/copy-data-to-another-excel-workbook-based-on-criteria-using-vba/
HTH

Related

Delete multiple rows across multiple sheets containing the same keyword

I have an excel file that contains around 50 sheets, all sheets have the same columns.
However, i would like to delete the entire rows that contains the same keyword "MARTIN" located in the 6th/last column in all the sheets.
I have tried to select all sheets at once and then delete the rows but it only worked for one sheet.
So if there is a way to do that either through an excel option or vba i'm all ears to suggestions.
Thank you
You could try:
Option Explicit
Sub test()
Dim ws As Worksheet
Dim LastRow As Long, i As Long
'Loop all sheets
For Each ws In ThisWorkbook.Worksheets
With ws
'Find the last row of column 6
LastRow = .Cells(.Rows.Count, 6).End(xlUp).Row
'Loop all rows in column 6 starting from the last one
For i = LastRow To 1 Step -1
'If the value is "MARTIN" then delete
If .Cells(i, 6).Value = "MARTIN" Then
.Rows(i).EntireRow.Delete
End If
Next i
End With
Next ws
End Sub
A quicker way to do it is to use shortcuts to delete the row and then go to the next sheet:
Say you want to delete the 6th row:
Go to the 6th row and hit Shift+Space this will highlight the entire row
To delete the row Ctrl + - (Ctrl and the minus sign)
Then to go from sheet one to sheet two you Ctrl + Page Down btn
If you really want to save time and know VBA you can create a short script. Unfortunately, I'm on my mac so I can't test one out right now but I found a good link that gives you a step by step here
Hope this helps!

Copy all values in Column D from unknown number of worksheets with unknown number of rows into a single Column A of values in a master worksheet

This is my first question on SO and I'd really appreciate the direct help:
I have an Excel file with multiple worksheets. In Column D of each worksheet, I've created insert SQL statements based on each row's dynamic data. I'd now like to copy all of the insert statements that I've created in Column D on each worksheet into one big column so I can run them all into my database.
Thanks SO much for the help :)
To implement:
Create new sheet titled Master
Give cell A1 a header name
Open VBE
Insert Module
Copy and paste code as is into module
The code will:
Loop through each sheet
Copy cells in Col D from D2 To Last Non-Blank Row
Paste values only on Master in next available Non-Blank Row in Col A
Loop 2 - 3 for all sheets
Option Explicit
Sub MyDearMacro()
Dim ws As Worksheet, Master As Worksheet
Set Master = ThisWorkbook.Sheets("Master")
Dim CopyRange As Range, PasteRange As Range
Application.ScreenUpdating = False
For Each ws In Worksheets
If ws.Name <> "Master" Then
Set CopyRange = ws.Range("D2:D" & ws.Range("D" & ws.Rows.Count).End(xlUp).Row)
Set PasteRange = Master.Range("A" & Master.Rows.Count).End(xlUp).Offset(1)
CopyRange.Copy: PasteRange.PasteSpecial xlPasteValues
End If
Next ws
Application.ScreenUpdating = True
MsgBox "Please take the tour page of Stack OverFlow and show an attempt to solve on your next post.", vbCritical
End Sub
Closing Notes:
You will need to amend this if you do not want duplicates (if they exist). You may also need to amend this if your SQL Statements do not cover every row in the copy range (you may end up with blank cells separating your Statements). AKA once loop is done, remove blanks and duplicates in Col A on Master sheet.

Find all rows based on a cell value and copy to different sheet.

I am a excel/vba noob. I have very little experience with vba. I am not asking for someone to do my work for me just help me with some samples so I can start figuring out what I need.
I have been looking for a way to help me search a spread sheet based on a value I place in a cell. Here is what I have. I have a spread sheet that has 4 tabs, the first 3 tabs have different data and different number of columns. The one thing that is the same on each table is the first three columns.
date case# ticket#
7/14/2018 50807966 5330826969
7/3/2018 50811017 5330860547
7/1/2018 50811022 5330860631
7/13/2018 50811026 5330860683
What I want to do is on sheet 4 enter a number in a cell labeled ticket# and find all rows on each sheet and copy it to the 4th sheet. I want it to copy each row found to the next empty row on sheet 4. I will start with sheet one and work through sheet 3.
What I would like help on is how to do the first sheet. Once I have an Idea of how to do one sheet I can figure out how to do the rest.
Its not clear what your 4th sheet looks like. This will look for a ticket number on your 4th sheet in cell A1.
Once executed, it will loop through each sheet and filter/copy/paste the first 4 columns for all values in filter.
You will need to change .Sheets("Sheet4") to match your sheet: .Sheets("?")
Option Explicit
Sub Macro1()
Dim Ws As Worksheet, MyWs As Worksheet
Dim wsLRow As Long, MyLRow As Long
Set MyWs = ThisWorkbook.Sheets("Sheet4")
Dim TicketNumber As String
TicketNumber = MyWs.Range("A1")
Application.ScreenUpdating = False
For Each Ws In Worksheets
If Ws.Name <> MyWs.Name Then
With Ws
If .AutoFilterMode Then .AutoFilterMode = False
wsLRow = .Range("A" & .Rows.Count).End(xlUp).Row
MyLRow = MyWs.Range("A" & MyWs.Rows.Count).End(xlUp).Offset(1).Row
.Range("A:A").AutoFilter 1, TicketNumber
.Range("A2:D" & wsLRow).SpecialCells(xlCellTypeVisible).Copy
MyWs.Range("A" & MyLRow).PasteSpecial
.AutoFilterMode = False
End With
End If
Next Ws
Application.ScreenUpdating = True
End Sub
If will need to handle the error when your filter does not find anything.

How to copy data to multiple sheets from first excel sheet in a workbook

I want to copy cells A103 to Y148 from first sheet to every sheet in my excel workbook. What code I should use?
Here is a four-step approach.
1. Design the action in plain words, like,
' loop through rows 103 to 148 in Sheet1
' copy the row
' loop through all other sheets in the workbook
' paste the row in the first empty row at the bottom of each
Research code for each action. For example, google for "VBA Excel loop through rows"
Be amazed at the multitude of ready-to-use code you will find, and at how quickly you will learn to do impossible things.
Come back here with any problems you can't solve on your own.
Depending on what you mean by 'every sheet in my excel workbook', this may be faster than looping a paste operation through all of the remaining worksheets.
Sub galumph()
Dim w As Long, wss As String, wsa as Variant
For w = 2 To Worksheets.Count
wss = wss & IIf(CBool(Len(wss)), ";", vbNullString) & Worksheets(w).Name
Next w
wsa = Split(wss, ";") 'make array of worksheet names
Worksheets(1).Range("A103:Y148").Copy 'copy from A103:Y148 on Sheet1
Worksheets(wsa).Select 'select all of the remaining worksheets
Worksheets(wsa(0)).Range("A1").Activate 'activate the destination on one of the worksheets
Worksheets(wsa(0)).Paste 'paste the data into all worksheets
End Sub

Consolidation of data sheets onto one worksheet

I have a workbook with about 14 worksheets. A selected set of worksheets contains the data which will be updated. They need to stay separated for the users.
To summarize this data to produce a report, I need to combine all the data sheets (all in the same format) into one for the final summary calculation (so the =AVERAGEIFSfunction could work and some other manually calculated averaging formulae would be more accurate).
I'm thinking of tackling the problem with either of two approaches:
Have the combined datasheet reference each cell on the data sheet individually. My formula is =Sheet1!A1.
The issue is that if any of the rows on the original datasheet gets deleted, it will cause calculation errors on the combined datasheet.
I saw a recommendation of =INDIRECT("Sheet!A1"), but this will not fill correctly across and down the worksheet, meaning I would have to update about 40K cells individually.
A macro or a set of formulae that will pick up data automatically (I'd prefer not to have a running command for the macro).
The design of the macro/formula is to pick up each row from selected worksheets, discontinue once it hits the first blank row and move onto the next selected worksheet, like a loop.
Any other suggestions on how to achieve this would also be highly welcome.
Sub combineDatasheets()
Dim sh As Worksheet
For Each sh In Sheets
If sh.Name <> "Combined datasheet" Then
a = sh.Cells(1, 1).End(xlDown).Row 'count rows untill blank
b = Sheets("Combined datasheet").Cells(1, 1).End(xlDown).Row 'last row with data
'find if there's any data already in "Combined datasheet" by looking at cell A1
If Sheets("Combined datasheet").Cells(1, 1).Value = "" Then
b = 0
End If
sh.Rows("1:" & a).Copy Destination:=Sheets("Combined datasheet").Range("A" & b + 1)
End If
Next sh
End Sub
This will get you all the rows with data until the first blank row from each worksheet (ignoring the one where you are consolidating the data, of course) and paste them in the "Combined datasheet" contiguously.
Change the name of the "Combined datasheet" worksheet if necessary.
Note: if the first row is blank, no data will be retrieved from that worksheet.
Hope this helps!
EDIT:
Ok so, if I understood correctly, you want to refresh the data in your consolidated sheet every time a value changes in any other datasheet.
So for that use the following code in every worksheet that you want to retrieve data from (the 7 worksheets you mentioned, I guess):
Private Sub Worksheet_Change(ByVal Target As Range)
Call combineDatasheets
End Sub
Now the following code goes to a module (VBA->Insert->Module):
Sub combineDatasheets()
Dim sh As Worksheet
'Clear data in "Combined datasheet"
c = Sheets("Combined datasheet").Cells(1, 1).End(xlDown).Row
Sheets("Combined datasheet").Range("A1:A" & c).EntireRow.ClearContents
For Each sh In Sheets
If sh.Name <> "Combined datasheet" Then
a = sh.Cells(1, 1).End(xlDown).Row 'count rows untill blank
'fix error when there's only 1 row with data
If sh.Cells(2, 1).Value = "" Then
a = 1
End If
b = Sheets("Combined datasheet").Cells(1, 1).End(xlDown).Row 'last row with data
'find if there's any data already in "Combined datasheet" by looking at cell A1
If Sheets("Combined datasheet").Cells(1, 1).Value = "" Then
b = 0
Else
'fix error when "Combined datasheet" worksheet has only one row with data
If Sheets("Combined datasheet").Cells(2, 1).Value = "" Then
b = 1
End If
End If
sh.Rows("1:" & a).Copy Destination:=Sheets("Combined datasheet").Range("A" & b + 1)
End If
Next sh
End Sub
Regarding the error you're getting, I think it's because you haven't changed the name of the worksheet that consolidates the information. You need to either change the name to "Combined datasheet" (without quotation marks) so it can work with the code I've written, or you go directly to the code and change the name in there to one of your own choice (every time you see "Combine datasheet" change to the name you want inside the quotation marks).
I hope this will work correctly this time to you :)

Resources