![]() |
#1
|
|||
|
|||
![]()
I am trying to find an automated solution for the following daily task. I have a master workbook with 13 sheets.
Sheet names are Jan-Dec (all 12 months) and Data. Every sheet has 2 sets of 3 columns: Item Code (A1), Year (B1), Price (C1) and Item Code (E1), Year (F1), Price (G1). Every day I have over 1000 new entries in "Data" sheet and then have to find matching item code (in Column A) in other 12 sheets, columns A-C, cut and move new matching data to E-G and highlight the new entries. I have tried the following vba codes: Code:
Sub TestNewCode() Application.ScreenUpdating = False Dim varMainRange As Range Dim varSubRange As Range Set varMainRange = Range(Worksheets("Jul").Range("A2:C65536"), _ Worksheets("Jul").Range("A65536").End(xlUp)) For Each MainCell In varMainRange Set varSubRange = Range(Worksheets("Data").Range("A2"), _ Worksheets("Data").Range("A65536").End(xlUp)) For Each SubCell In varSubRange If MainCell.Value = SubCell.Value Then Worksheets("Data").Range("A2:C2").Copy _ Worksheets("Jul").Range("E2:G2") Exit For End If Next SubCell Next MainCell Application.ScreenUpdating = True End Sub Code:
Sub TestNewCode() Const Tabs As String = "Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec" Dim WsData As Worksheet Dim Ws As Worksheet ' any of the monthly sheets Dim WsName() As String Dim Rend As Long, Rl As Long ' last row in WsData / Ws Dim R As Long, Rm As Long ' row counter WsData / Ws Dim Entry As Variant ' one Data entry Set WsData = Worksheets("Data") WsName = Split(Tabs, " ") Application.ScreenUpdating = False With WsData Rend = .Cells(.Rows.Count, "A").End(xlUp).Row For R = 2 To Rend Entry = .Range(.Cells(R, 1), .Cells(R, 3)).Value ' A:C Rm = FindMatch(Entry, Ws, WsName) If Rm Then ' rm = 0 if not found With Ws.Cells(Rm, 5).Resize(1, UBound(Entry, 2)) .Value = Entry .Interior.Color = vbYellow End With End If Next R End With Application.ScreenUpdating = True End Sub Private Function FindMatch(Entry As Variant, _ Ws As Worksheet, _ WsName() As String) As Long ' return zero if no match was found Dim Rng As Range ' search range Dim Fnd As Range Dim Rl As Long Dim i As Long For i = 0 To UBound(WsName) On Error Resume Next Set Ws = Worksheets(WsName(i)) If Err Then MsgBox "Worksheet " & WsName(i) & " doesn 't exist.", _ vbInformation, "Missing worksheet" Else With Ws Rl = .Cells(.Rows.Count, 1).End(xlUp).Row Set Rng = .Range(.Cells(2, 1), .Cells(Rl, 3)) Set Fnd = Rng.Find(What:=Entry(1, 1), _ After:=Rng.Cells(Rng.Cells.Count), _ LookIn:=xlValues, _ Lookat:=xlWhole, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlNext, _ MatchCase:=False, _ MatchByte:=False) If Not Fnd Is Nothing Then FindMatch = Fnd.Row Exit For End If End With End If Next i If Fnd Is Nothing Then MsgBox "Code " & Entry(1, 1) & " wasn't found.", _ vbInformation, "Missing Code" End If End Function 1- In my monthly sheets now I have 2 sets of columns as you can see in picture. As you can see in first set of columns I have 8 titles A-H (REPORT # | DATE | TRANSACTION ID | ITEM CODE | YEAR | PRICE | NOTES | SOLD BY), and in second set I have 4 titles J-M (REPORT # | ITEM CODE | YEAR | PRICE). 2- In DATA sheet I have 1 set of columns with 4 titles A-D (REPORT # | ITEM CODE | YEAR | PRICE). See picture here. Improvements I'm looking to make: 1- If finds matches in month tabs (cells A:H) for cells B:C in "DATA" sheet, move (cut) cells A:D from "DATA" to matching month's cells J:M and highlight it yellow. 2- If finds 2 or more matches, first try to move it to the first match, but in case if the first one already has a matching data, move it to the second one. 3- If finds only one match and already there is a data in cells J:M, insert a row below, add data and highlight it blue. 4- If no match finds, highlight cells red in "DATA" tab. Hope someone can help with this improvement. Edit mod :cross posted here Last edited by Pecoflyer; 09-22-2017 at 11:22 PM. Reason: Changed last sentence with ref to cross post |
#2
|
||||
|
||||
![]()
Please,do not crosspost your question on multiple forums without including links here to the other threads on other forums.
Cross-posting is when you post the same question in other forums on the web. The last thing you want to do is waste people's time working on an issue you have already resolved elsewhere. We prefer that you not cross-post at all, but if you do (and it's unlikely to go unnoticed), you MUST provide a link (copy the url from the address bar in your browser) to the cross-post. Read this to understand why we ask you to do this, and then please edit your first post to include links to any and all cross-posts in any other forums (not just this site). Do not post any further responses in this thread until a link has been provided to these cross posts.
__________________
Using O365 v2503 - Did you know you can thank someone who helped you? Click on the tiny scale in the right upper hand corner of your helper's post |
#3
|
|||
|
|||
![]()
Please see a sample workbook to have a better idea.
|
#4
|
||||
|
||||
![]()
Please add links to ALL your cross-posts - Thank you
__________________
Using O365 v2503 - Did you know you can thank someone who helped you? Click on the tiny scale in the right upper hand corner of your helper's post |
#7
|
||||
|
||||
![]()
@debaser
Thank you. OP had already added that link in post #1
__________________
Using O365 v2503 - Did you know you can thank someone who helped you? Click on the tiny scale in the right upper hand corner of your helper's post |
#8
|
||||
|
||||
![]()
Ah, sorry - I didn't see that one!
|
#9
|
|||
|
|||
![]()
Hi there,
With regards to this line of code have you considered using current region? If you use .End and there are gaps in your data ever it's not accurate. Whereas CurrentRegion is like clicking in a cell in a range and pressing Ctrl+Shift+* to work out the contiguous range even if there are gaps in any cells in the first column. Rend = .Cells(.Rows.Count, "A").End(xlUp).Row Change to: Rend = .Range("A1").CurrentRegion.Rows.Count Also seeing as you are reading so many lines of data from Excel, it may be quicker to make a SQL query using ADO.DB to get the data out of the source worksheet & output it to the destination worksheet. Once your SQL query is run, you do not need to loop through the recordset like you are through your worksheet. If you write the correct SQL query you would get the result of your query, then you output the recordset result in one line of code, e.g. oRange.CopyFromRecordset oADORecordSet - which would be quicker. Kind regards |
![]() |
Tags |
excel improvement, vba |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
eNGiNe | Forum Support | 1 | 09-14-2016 04:14 PM |
![]() |
raminraiszadeh | Project | 1 | 04-05-2016 06:05 AM |
Form improvement | edayers315 | Word | 0 | 08-19-2011 09:55 AM |