I have one excel sheet that I manage to which I need to add rows if new rows have been added to another excel sheet that I am not managing.
To put it simply I may be sitting with an excel sheet that looks like this:
And I need to search another excel sheet (see image 2) for newly added rows based on document code column which would look like this:
And ideally I would like that my excel sheet would end up looking like this where new lines were added if they contained a document code not previously in my excel sheet:
I have seen similar questions answered before but only for more simple searches like based on fixed values in the cell e.g. like yes/no and I did not quite manage to revise those answers to my situation. .
You could try:
Sub test()
Dim wsAll As Worksheet, wsNew As Worksheet
Dim LastRowNew As Long, LastrowAll As Long, i As Long
Dim rngFound As Range
With ThisWorkbook
'The sheet with all data
Set wsAll = .Worksheets("All_Imports")
'The sheet with new data
Set wsNew = .Worksheets("New_Imports")
End With
With wsNew
LastRowNew = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 2 To LastRowNew
Set rngFound = wsAll.Columns(1).Find(.Range("A" & i).Value, LookIn:=xlValues, LookAt:=xlWhole)
If rngFound Is Nothing Then
With wsAll
LastrowAll = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Range("A" & LastrowAll).Value = wsNew.Range("A" & i).Value
.Range("B" & LastrowAll).Value = wsNew.Range("B" & i).Value
End With
End If
Next i
End With
End Sub
Related
I'm trying to help a colleague with an excel report. He is not very good with computers and is making errors in copying all the relevant data from one sheet to another. He's working with a dataset that looks like this:
] [1]: https://i.stack.imgur.com/dHUpt.png (not allowed to upload images directly yet because i created a new account)
These are pending shipping values and everyday a report is generated with all the orders and the pending ones need to be copied into another sheet and then their status is updated in that excel sheet.
What I need is a solution that when I paste my report into sheet one, I can run a VBA code and compare all the values in column B of sheet one to all the values in column B of sheet two. Then, whatever is not present in column B of sheet two can be highlighted in sheet one or pasted into sheet three/ appended into sheet two. In this way, they operator does not have to do the lookup by himself.
If there is any other solution than VBA that could help, feel free to suggest. Thanks!
You can try this:
Sub CompareData()
Application.ScreenUpdating = False
On Error GoTo 0
Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Set ws1 = wb.Worksheets("Sheet1") 'Change Sheet Name
Set ws2 = wb.Worksheets("Sheet2") 'Change Sheet Name
ws1.Copy after:=ws2
Set ws3 = wb.ActiveSheet
Dim LastRow1 As Long
Dim Rng As Range
With ws3
LastRow1 = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("E1").Value = "Vlookup"
.Range("E2").Value = "=VLOOKUP(B2," & ws2.Name & "!B:B,1,0)"
.Range("E2").Copy .Range("E3:E" & LastRow1)
.Range("A1:E1").AutoFilter FIELD:=5, Criteria1:="#N/A"
Set Rng = .AutoFilter.Range.Offset(1, 0)
Set Rng = Rng.Resize(Rng.Rows.Count, 4)
End With
Dim LastRow2 As Long
LastRow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
Rng.Copy ws2.Range("A" & LastRow2 + 1 & ":D" & LastRow2 + 1)
Application.DisplayAlerts = False
ws3.Delete
Application.DisplayAlerts = True
ws2.Activate
Exit Sub
0:
MsgBox "Something went wrong"
Application.ScreenUpdating = True
End Sub
Don't forget to change your sheet name.
For such tasks (comparing data in different worksheets), I usually use Excel built-in IF funcion. Example: =IF([Workbook_1]Sheet_1!B1=[Workbook_2]Sheet_2!B1,".",FALSE). Then, just fill down the formula (dragging down).
Note: . is used for easiness of distinguishing FALSE values.
I have this code where it loops through all the sheets in the workbook and copies the value in F9 of each sheet and pastes it in "Summary" sheet column A. How can I also print the sheet name in column B? So the value is next to the sheet name in the "Summary" sheet.
code:
Sub loopsheet()
Dim wks As Worksheet
For Each wks In ThisWorkbook.Worksheets
If Not wks.Name = "Summary" Then
wks.Range("F9:F" & wks.Cells(Rows.Count, "F").End(xlUp).Row).Copy _
Destination:=Worksheets("Summary").Cells(Rows.Count, "A").End(xlUp).Offset(1)
End If
Next
End Sub
Thank you
Create two variables to track the last rows of your sheets as you loop. This will help with readability in your code. The combination of these two variables can also help you deduce the size of the range where you need to drop your sheet name.
I believe cLR + pLR - 11 is the size of range. The offset is due to headers, LR offset, and the fact that you are starting your copy from the 9th row. After you run this, you may need to tweak it up or down one if i'm wrong.
Option Explicit
Sub LoopSheet()
Dim ws As Worksheet
Dim Summary As Worksheet: Set Summary = ThisWorkbook.Sheets("Summary")
Dim cLR As Long, pLR As Long
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> Summary.Name Then
cLR = ws.Range("F" & ws.Rows.Count).End(xlUp).Row
pLR = Summary.Range("A" & Summary.Rows.Count).End(xlUp).Offset(1).Row
ws.Range("F9:F" & cLR).Copy Summary.Range("A" & pLR)
Summary.Range(Summary.Cells(pLR, 2), Summary.Cells(cLR + pLR - 11, 2)).Value = ws.Name
End If
Next ws
End Sub
Okay, so here goes. I have a workbook with individual worksheets for each day detailing the stock trading activity. I also currently have a VBA which provides a sum total for specified columns on each of these worksheets, and this works fine.
However, what I would like to do is add to my VBA so that it provides a sum total for these columns into the master worksheet.
So, for example: If there was trading activity totalling 4m on the 1st Oct 2018 on worksheet 1, and trading activity totalling 3m on 2nd october 2018 on worksheet 2, I would like to have this total of 7m shown on the master worksheet.
I've attached my current vba below, the column currently being summed on each individual worksheet is J. The columns summed on the individual worksheet do not change, however the amount of data contained in those columns obviously does depending on trading activity.
Sub autoSum_AllSheets()
Dim ws As Worksheet
Dim cel1 As String, cel2 As String
Dim firstCel As Range
For Each ws In ActiveWorkbook.Worksheets
With ws
Set firstCel = .Range("J3").End(xlDown).Offset(2, 0)
cel1 = firstCel.Offset(-2, 0).End(xlUp).Address
cel2 = firstCel.Offset(-1).Address
firstCel.Value = "=SUM(" & cel1 & ":" & cel2 & ")"
End With
Next ws
End Sub
I've also attached a screenshot of a current mock worksheet taken from a random day, with the sum total i get after running the vba bolded and highlighted in red.
Any advice on how to approach this would be great as I'm a newcomer to all things VBA.
Edit: I've attached a mock screenshot of what I'm trying to achieve on the master worksheet below:
I recommend the following …
Option Explicit
Public Sub AutoSumAllWorkheets()
Const MasterName As String = "Master" 'specify name of master sheet
Dim wsMaster As Worksheet
On Error Resume Next 'test if master exists
Set wsMaster = ActiveWorkbook.Worksheets(MasterName)
On Error GoTo 0
If wsMaster Is Nothing Then 'add master if not exists
Set wsMaster = ActiveWorkbook.Worksheets.Add(Before:=ActiveWorkbook.Worksheets(1))
wsMaster.Name = MasterName
'instead you can throw a message and exit here
'MsgBox "No master found"
'Exit Sub
End If
Dim FirstCell As Range, LastCell As Range
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
With ws
If .Name <> MasterName Then 'don't sum on master sheet
Set FirstCell = .Range("J3")
Set LastCell = FirstCell.End(xlDown)
LastCell.Offset(2, 0).Formula = "=SUM(" & FirstCell.Address & ":" & LastCell.Address & ")"
'write in master
With wsMaster.Cells(wsMaster.Rows.Count, "A").End(xlUp)
.Offset(1, 0).Value = ws.Name
.Offset(1, 1).Formula = "=" & LastCell.Offset(2, 0).Address(External:=True)
End With
End If
End With
Next ws
'sum all sheets up
With wsMaster.Cells(wsMaster.Rows.Count, "A").End(xlUp)
.Offset(2, 0).Value = "Total sum:"
.Offset(2, 1).Formula = "=SUM(" & wsMaster.Cells(1, "B").Address & ":" & .Offset(0, 1).Address & ")"
End With
End Sub
The first part checks if a master sheet exists and adds one if it doesn't exist.
Then I improved your code a bit:
I recommend to use clear variable names (makes it easier). For example your firstCel actually was not the first but the sum cell. That is very confusing and you will easily fail.
Use .Formula to write a formula.
I added some code to write the sums of each sheet into the master sheet. Note that this appends the entries at the master sheet. So if you run it twice you need to clear the entries in the master sheet first.
If you want to write into another column of the master sheet just change the column name of wsMaster.Cells(wsMaster.Rows.Count, "A").End(xlUp) from "A" to eg "L"
Try:
Sub test4()
Dim ws As Worksheet
Dim LastRowJ As Long
Dim MasterTotal As Double
For Each ws In ActiveWorkbook.Worksheets
LastRowJ = ws.Cells(ws.Rows.Count, "J").End(xlUp).Row
MasterTotal = MasterTotal + ws.Range("J" & LastRowJ).Value '<= Let us assume that total appears in each sheet at the last line in column J
Next ws
Sheet1.Range("A1").Value = MasterTotal '<= Change where you want to import the total of totals
End Sub
Hoping you can help, please!
So I have 2 worksheets, 1 & 2. Sheet1 has already existing data, Sheet2 is used to dump raw data into. This is updated daily, and the data dump includes both data from previous days, as well as new data. The new data may include rows relating to interactions that may have happened earlier in the month, not just the previous day. So the data is not "date sequential".
There are 9 columns of data, with a unique identifier in column I.
What I'm needing to happen is when running the macro, it looks in column I in Sheet1 and Sheet2, and only copies and pastes rows where the unique identifier in Sheet 2 doesn't already exist in Sheet1. And pastes them from the last empty row onwards in Sheet1.
What I currently have is this - it's all I could find online:
Sub CopyData()
Application.ScreenUpdating = False
Dim LastRow As Long
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim rng As Range
Dim foundVal As Range
For Each rng In Sheets("Sheet2").Range("A1:I" & LastRow)
Set foundVal = Sheets("Sheet1").Range("I:I").Find(rng, LookIn:=xlValues, LookAt:=xlWhole)
If foundVal Is Nothing Then
rng.EntireRow.Copy Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
Next rng
Application.ScreenUpdating = True
End Sub
But it's just not working - not only does it not recognise if the value in column I already exists, it's copying and pasting only the first 2 rows from Sheet2, but duplicating them 8 times each!
Apologies in advance, I'm a real VBA novice, and just can't work out where it's all going wrong. I would appreciate any assistance!
This will do what you want:
Sub testy()
Dim wks As Worksheet, base As Worksheet
Dim n As Long, i As Long, m As Long
Dim rng As Range
Set wks = ThisWorkbook.Worksheets(2) 'Change "2" with your input sheet name
Set base = ThisWorkbook.Worksheets(1) 'Change "1" with your output sheet name
n = base.Cells(base.Rows.Count, "A").End(xlUp).Row
m = wks.Cells(wks.Rows.Count, "A").End(xlUp).Row
For i = 2 To m
On Error Resume Next
If IsError(WorksheetFunction.Match(wks.Cells(i, 9), base.Range("I:I"), 0)) Then
Set rng = wks.Cells(i, 1).Resize(1, 9) 'Change 9 with your input range column count
n = n + 1
base.Cells(n, 1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
End If
Next i
End Sub
I'm learning VBA in Excel 2013 and I posted a question last weekend but didn't receive a response. I've been working on the code more and narrowed the error down to one. I'm trying to highlight a row in a workbook if a value in column A is found in the column A another open workbook.
I get a Runtime error 13: Type mismatch error. That is all that it says and it is for this line of code:
If cell.Value = valuetofind Then
I have looked on numerous sites about this error but I don't see any that match my situation. I think it's b/c 'valuetofind' is a range and it's trying to set a range equal to a value, seen in 'cell.value'. I think all of my variables are declared properly.
I've tried changing it to below so that they are both ranges but that gives the same error:
If cell = valuetofind Then...
Can anyone help with this error?
Sub HighlightRow()
'http://www.vbaexpress.com/forum/showthread.php?26162-Solved-Highlight-ROW-based-on-cell-value
'http://www.mrexcel.com/forum/excel-questions/827262-visual-basic-applications-vlookup-between-2-workbooks.html
'test column just picks any column, I think, to test how far down the rows go to, I think you could choose any column
Const TEST_COLUMN As String = "D" '<=== change to suit
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim LastRow As Long
Dim cell As Range
Dim valuetofind As Range
Set ws1 = ThisWorkbook.Sheets(1) 'name will change each day
Set ws2 = ActiveWorkbook.Sheets(1) 'name will change each day
With ws1
LastRow = Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
'LastRow is testing/finding out last row using TEST_COLUMN first before performs rest of macro
End With
Set valuetofind = ws2.Range("A2:A" & LastRow)
'Range("A2:A" & LastRow) is the criteria row where it is looking for Break Down and PM/SM Call below
'Resize(,7) will highlight the row however many columns you tell it to, in this case 7
'cell.Offset(, -6) I think tells to go back 6 columns to column A and start the highlighting there
With ws1
For Each cell In Range("A2:A" & LastRow)
If cell.Value = valuetofind Then
'old, do not use: wb2.Worksheets(wb2SheetName).Range("A2:A" & LastRow)
cell.Offset(, -6).Resize(, 7).Interior.ColorIndex = 39
Else
cell.EntireRow.Interior.ColorIndex = xlNone
End If
Next
End With
End Sub
The code has been altered and is working for anyone who needs help.
This is modified from Dinesh Takyar's video on copying data between worksheets(https://www.youtube.com/watch?v=AzhQ5KiNybk_), though this code below is to highlight rows between workbooks. Both workbooks, destination and source workbooks, need to be open.
I believe the original Run Time 13 Error was b/c the criteria, original variable called 'valuetofind' was Dim as Range, when it is a String. The variable in the code below is now called 'myname' and is Dim as String. But I don't believe the code above would have worked anyway b/c I needed the For/Next to go through each cell in my criteria column.
Thanks to Dinesh and people on this forum.
Sub HighlightRowBtwWorkbook()
Dim wkbkDest As Workbook
Dim i As Long
Dim lastrowDest As Long
Dim lastcolDest As Long
Dim wkbkSource As Workbook
Dim j As Long
Dim lastrowSource As Long
Dim myname As String
Dim lastcolSource As Long
'Destination
Set wkbkDest = ThisWorkbook 'was Workbooks("Destination_VBAHighlight.xlsm") 'was ActiveWorkbook
lastrowDest = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
lastcolDest = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
For i = 2 To lastrowDest
myname = wkbkDest.ActiveSheet.Cells(i, "A").Value
'Source
Set wkbkSource = Workbooks("TESTVBA.xlsm")
wkbkSource.Activate
lastrowSource = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
lastcolSource = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
For j = 2 To lastrowSource
If ActiveSheet.Cells(j, "A").Value = myname Then
'Activate Destination
wkbkDest.Sheets(1).Activate
ActiveSheet.Range(Cells(i, "B"), Cells(i, lastcolDest)).Interior.Color = RGB(252, 228, 214)
End If
Next j
Next i
'select cell A1 in Destination wkbk to end there
wkbkDest.Sheets(1).Activate
wkbkDest.ActiveSheet.Range("A1").Select
End Sub