Gather data that don't exist from different worksheets to another workbook

**okela** · 06-02-2020, 06:07 AM

Hi,

I'm having trouble with a macro aiming at gathering data that don't exist to another existing workbook.
In my example, I have two sheets in the file "Input weeks". In each sheet, I have a list of weeks with a code for every days. If the week already exists in my database, then I get a code, but if it doesn't I want to add the new week created in my database "Catalogue weeks" at the end of the table to a new row.

For instance, in the sheet "Mail 1": the week "J000;D139;JRHE;A041;A043;D137;D137" already exists and the code is E351.
But the week "J001;J002;J003;J004;J005;J006;J007" does not exist and I would need to copy this week to the workbook "Catalogue weeks". Then, in the workbook "Catalogue weeks", I would give a code to this
newly created week and I would need this new code to appear on the sheet "Mail 1".

Last but not least, I can have several sheets named "Mail 1", "Mail 2", "Mail 3"... and I would need to loop accross all sheets.

Could you please help me?

If you have any question, feel free to ask.

Many thanks!

Okela

**Mumps1** · 06-02-2020, 09:46 AM

In column J of Mail 1, Mail 2, Mail 3 …. will there ever be a description which is duplicated among all the sheets?

**okela** · 06-02-2020, 10:07 AM

Hi Mumps1,

Yes, because this is generated thanks to the function TEXTJOIN.
Thanks!

Okela

**dangelor** · 06-02-2020, 10:26 AM

Try...

Sub Test()
    Dim wb As Workbook, ws As Worksheet
    Dim r As Range, c As Range
    Dim i As Long, lRow As Long
    
    Set wb = Workbooks("input_weeks.xlsm")
    For Each ws In wb.Worksheets
        If ws.Name Like "Mail*" Then
            For i = 4 To ws.Cells(ws.Rows.Count, 10).End(xlUp).Row
                With ThisWorkbook.Worksheets("Catalogue")
                    Set r = .Cells(1, 1).CurrentRegion
                    Set c = r.Columns(2).Find(ws.Cells(i, 10))
                    If Not c Is Nothing Then
                        ws.Cells(i, 11) = c.Offset(, -1)
                    Else
                        lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
                        Range(.Cells(lRow - 2, 1), .Cells(lRow, 1)).AutoFill Range(.Cells(lRow - 2, 1), .Cells(lRow + 1, 1)), 2
                        .Cells(lRow + 1, 2) = ws.Cells(i, 10).Value
                        .Cells(lRow + 1, 3).Resize(, 7) = ws.Cells(i, 3).Resize(, 7).Value
                        ws.Cells(i, 11) = .Cells(lRow + 1, 1).Value
                    End If
                End With
            Next i
        End If
    Next ws
End Sub

**okela** · 06-02-2020, 10:44 AM

Hi dangelor!

Many thanks! It's working really well, I would just need a small adjustement.
In my case, I would need to manually define the code of the new week in the Workbook "Catalogue weeks" and then it would update the name in the sheet "Mail 1" for example.
For example, the code of new week would not be E364 but AJ01.

Do you think we can tweak it a little bit?

Many thanks!!

Okela

**dangelor** · 06-02-2020, 10:50 AM

You could remove this line of code

Range(.Cells(lRow - 2, 1), .Cells(lRow, 1)).AutoFill Range(.Cells(lRow - 2, 1), .Cells(lRow + 1, 1)), 2

then add your definition and then rerun the subroutine.

...or do you want the adding of the update as part of the subroutine?

**okela** · 06-02-2020, 10:54 AM

Is this possible thanks to a VLOOKUP for instance? Ideally, I would need that once the code is entered on the Catalogue Weeks, the sheet "Mail 1" gets updated automatically.

**Mumps1** · 06-02-2020, 11:04 AM

Are the codes in column A of Catalogue always sequential, that is E47, E348, E349 ….. ?

**okela** · 06-02-2020, 11:28 AM

Hi Mumps1,
No it can be really different. E500, A501, AA01... It has always 4 characters but it can be really different.

**dangelor** · 06-02-2020, 11:03 AM

Do you mean...?

Formula:

=VLOOKUP(J9,Catalogue_weeks.xlsx!Tableau2[#Data],1,0)

You could but the code already does that, just in a different way with this...

Set c = r.Columns(2).Find(ws.Cells(i, 10))
          If Not c Is Nothing Then
               ws.Cells(i, 11) = c.Offset(, -1)

**okela** · 06-02-2020, 11:13 AM

Originally Posted by dangelor

Do you mean...?

Formula:

=VLOOKUP(J9,Catalogue_weeks.xlsx!Tableau2[#Data],1,0)

You could but the code already does that, just in a different way with this...

Set c = r.Columns(2).Find(ws.Cells(i, 10))
          If Not c Is Nothing Then
               ws.Cells(i, 11) = c.Offset(, -1)

Ok, I see! It means that I need to launch the macro twice?

**dangelor** · 06-02-2020, 11:15 AM

Ok, I see! It means that I need to launch the macro twice?

After you update the table, yes.

**okela** · 06-02-2020, 11:29 AM

Ok great! Thanks dangelor!

**Mumps1** · 06-02-2020, 11:32 AM

If you are willing to let the macro generate the codes automatically and sequentially, try this macro in the Input_Weeks workbook. You will have to run it only once.

Sub MatchData()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, arr1 As Variant, arr2 As Variant, Val As String, ws As Worksheet, LastRow As Long, i As Long
    Set desWS = Workbooks("Catalogue_weeks.xlsx").Sheets("Catalogue")
    arr2 = desWS.Range("B2", desWS.Range("B" & Rows.Count).End(xlUp)).Value
    Set rnglist = CreateObject("Scripting.Dictionary")
    For Each ws In Sheets
        arr1 = ws.Range("C4", ws.Range("C" & Rows.Count).End(xlUp)).Resize(, 8).Value
        For i = 1 To UBound(arr2, 1)
            Val = arr2(i, 1)
            If Not rnglist.Exists(Val) Then
                rnglist.Add Val, Nothing
            End If
        Next i
        For i = 1 To UBound(arr1, 1)
            Val = arr1(i, 8)
            If Not rnglist.Exists(Val) Then
                With desWS
                    .Cells(.Rows.Count, "B").End(xlUp).Offset(1).Resize(, 8).Value = Array(Val, arr1(i, 1), arr1(i, 2), arr1(i, 3), arr1(i, 4), arr1(i, 5), arr1(i, 6), arr1(i, 7))
                    .Cells(.Rows.Count, "A").End(xlUp) = Left(.Cells(.Rows.Count, "A").End(xlUp).Offset(-1), 1) & Mid(.Cells(.Rows.Count, "A").End(xlUp).Offset(-1), 2, 9999) + 1
                End With
            End If
        Next i
    Next ws
    Application.ScreenUpdating = True
End Sub

**Marc L** · 06-02-2020, 11:47 AM

According to the attachment as a VBA beginner starter to paste to the inputs_weeks workbook
(once the catalogue 'database' is updated run it again) :

PHP Code:


Sub Demo1()

  Const S = "Catalogue", D = S & "_weeks.xlsx"

    Dim V, Ls As ListObject, Ws As Worksheet, Rg As Range

        V = Evaluate("ISREF('[" & D & "]" & S & "'!A1)"):  V = IIf(IsError(V), False, V):  If Not V Then Beep: Exit Sub

        If Workbooks(D).Worksheets(S).ListObjects.Count = 0 Then Beep: Exit Sub

        Set Ls = Workbooks(D).Worksheets(S).ListObjects(1)

        Application.ScreenUpdating = False

    For Each Ws In ThisWorkbook.Worksheets

        With Ws.Range("C4:I" & Ws.[C3].End(xlDown).Row)

                 .Columns(9).Replace "?", Empty, xlWhole

                  Set Rg = .Columns(9).Find(Empty, , xlValues, xlWhole)

            While Not Rg Is Nothing

                       V = Application.Match(Rg(1, 0), Ls.ListColumns(2).DataBodyRange, 0)

            If IsError(V) Then

                Ls.ListRows.Add:  V = Ls.ListRows.Count

                Ls.ListRows(V).Range.Columns("A:B") = Array("?", Rg(1, 0))

                Ls.ListRows(V).Range.Columns("C:I") = .Rows(Rg.Row - 3).Value2

            End If

                      Rg = Ls.ListRows(V).Range(1).Value2

                  Set Rg = .Columns(9).FindNext(Rg)

            Wend

        End With

    Next

        Application.ScreenUpdating = True

        Set Ls = Nothing

End Sub

► Do you like it ? ► ► So thanks to click on bottom left star icon « ★ Add Reputation » ! ◄ ◄

**okela** · 06-02-2020, 12:16 PM

Hi Mumps and Marc,

Many thanks for your answers but I'll go with the solution provided by dangelor because it suits my needs and with my knowledge in VBA, I understand it better.

Thanks once again!

Okela

**okela** · 06-02-2020, 12:27 PM

Dangelor,

If I may, in my original file the catalogue actually starts at column B, could you please indicate me which line do I need to change?

I would also need another tweak if possible. Once my weeks are created, I need to transpose the data to another sheet and create a new code (I have updated both examples accordingly).
For example, in the sheet "Mail 1", the working cycle created is AA01 (it comes from the tab "Work cycle"). Could you please help me with that?

Many thanks!

Okela

**dangelor** · 06-02-2020, 12:53 PM

If I may, in my original file the catalogue actually starts at column B, could you please indicate me which line do I need to change?

This...

Set r = .Cells(1, 1).CurrentRegion

to...

Set r = .Cells(1, 2).CurrentRegion

For the rest, I think you should start a new thread.

**okela** · 06-02-2020, 01:06 PM

Thank you dangelor!

**dangelor** · 06-02-2020, 01:07 PM

Glad to help!

Gather data that don't exist from different worksheets to another workbook

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Gather data that don't exist from different worksheets to another workbook

Re: Gather data that don't exist from different worksheets to another workbook

Re: Gather data that don't exist from different worksheets to another workbook

Re: Gather data that don't exist from different worksheets to another workbook

Re: Gather data that don't exist from different worksheets to another workbook

Re: Gather data that don't exist from different worksheets to another workbook

Re: Gather data that don't exist from different worksheets to another workbook

Re: Gather data that don't exist from different worksheets to another workbook

Re: Gather data that don't exist from different worksheets to another workbook

Re: Gather data that don't exist from different worksheets to another workbook

Re: Gather data that don't exist from different worksheets to another workbook

Re: Gather data that don't exist from different worksheets to another workbook

Re: Gather data that don't exist from different worksheets to another workbook

Re: Gather data that don't exist from different worksheets to another workbook

Hi ! Try this demonstration !

Re: Gather data that don't exist from different worksheets to another workbook

Re: Gather data that don't exist from different worksheets to another workbook

Re: Gather data that don't exist from different worksheets to another workbook

Re: Gather data that don't exist from different worksheets to another workbook

Re: Gather data that don't exist from different worksheets to another workbook

Thread Information

Users Browsing this Thread

Similar Threads

Gather data multiple sheets into 1 workbook

macro to let user know if one of 5 worksheets do not exist in active workbook

[SOLVED] Trying to use IF function to gather specific data from 2 worksheets

[SOLVED] VBA code to gather data from multiple worksheets in the same folder-Master List

copying worksheets from one workbook to another and overwriting if they exist already

working with multiple worksheets to gather data

[SOLVED] Copy Worksheet to a new Workbook creating if it doesn't exist and add more Worksheets if it does exist

Bookmarks

Bookmarks

Posting Permissions