CONSOLIDATED MI REPORT

[MoonLove]

Hi team, Iam a new joiner and I have a very urgent project to deliver.

I have 4 workbooks with the names ( Workbook 1,2,3,4). With each workbook, there are 3 common worksheets named sales, channels & products. . I managed to get VBA macro here to pull data that are in workbooks 1, 2, 3, & 4 and consolidate them into another workbook called "CONSOLIDATED MI REPORT" that have the same worksheet name as to those four workbooks I mentioned earlier.

My problem now is that, whenever I run the macro, data are pulled starting from the old top rows up to the new rows leading to duplications of information's. I want a macro that will only pull updated row data from workbook 1,2,3, & 4 then transfer the same to my consolidate MI report sheets respectively.

Please assist.

 

[MoonLove]

Hi Micron,

I have run the code but it doesn't copy range data that was not previously copied from my workbooks GK, SK,RJ and TB to consolidate report workbook.

Maybe the idea of flagging a column is somehow not clear to me but I amended the code as below and run it(replacing H with A):

Sub Copy_From_All_Workbooks()
Dim wb As String
Dim sh As Worksheet
Dim lngStartCopy As Long, Lrow As Long

RunMacro = Now + TimeValue("00:30:00")
Application.OnTime RunMacro, "Copy_From_All_Workbooks"
Application.ScreenUpdating = False
wb = Dir(ThisWorkbook.Path & "\*")
Do Until wb = ""
     If wb <> ThisWorkbook.Name Then
          Workbooks.Open ThisWorkbook.Path & "\" & wb
          For Each sh In Workbooks(wb).Worksheets
               lngStartCopy = sh.Cells(Rows.Count, "A").End(xlUp).Row + 1 'where to start copied range
               Lrow = sh.Cells(Rows.Count, "A").End(xlUp).Row 'where last row is with data in column A
              
               'if sheet is blank or flag/data is wrong, start row can be greater than end row
               If Not lngStartCopy > Lrow Then '
                    sh.Range("A" & lngStartCopy & ":A" & Lrow).EntireRow.Copy
                    ThisWorkbook.Sheets(sh.Name).Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues
                    Application.CutCopyMode = False
                    sh.Range("A" & lngStartCopy & ":A" & Lrow) = Date
               End If
          Next sh
          Workbooks(wb).Close False
     End If
wb = Dir
Loop

Application.ScreenUpdating = True

End Sub

 

[MoonLove]

Hi Micron or anyone to assist please.

The above code I run them on the consolidate report workbook(which is a destination workbook).

Unfortunately, it does not copy any data range which was not previously copied from the workbook GK,RJ,SK and TB to consolidated report.

Kindly please assist on this. I have a pending project to deliver.

 

[Micron]

Post some data that needs to be copied- no pictures.

 

[MoonLove]

Hi Micron,

Please see below table(this is how source workbooks appears).

All the four workbooks( GK, SK,RJ and TB )- which are source workbooks have 3 sheets (sales, channels, products) with each sheet having the below columns name shown on the below table.

Also, CONSOLIDATED WORKBOOK HAVE THE SAME THREE SHEET NAMES(SALES, CHANNELS, PRODUCTS) with the same column names as of those four workbooks GK,SK,RJ AND TB.

Date	Lead Code	Lead Name	YTD	Sales Code
08-01-2023	102	Serengeti	2023	201
08-01-2023	103	Manyara	2023	202
08-01-2023	104	Mikumi	2023	203

 

[Micron]

So you would want that to be copied or not? If yes, where's the flag column that indicates it was not copied yet?

 

[MoonLove]

Yes, I would want that data to be copied from each workbooks GK,SK,RJ and TB to CONSOLIDATED REPORT WORKBOOK.

The idea of having a flagging column I think from my end it's still not clear.

Instead, I would like to request the code that will copy data range from workbooks GK,SK,RJ and TB (with worksheets sales, channels and products) to CONSOLIDATED REPORT WORKBOOK(with worksheets sales, channels and products) based on the today's date data meaning the macro will have to be run on daily basis.

Thank you for your support Micron, I truly appreciate.

 

[Micron]

It's really quite simple and that worries me. Here, I added a column and when the copy is done, code puts (e.g.) that days date in the rows so that next time it only copies those rows where there is no date "flag". In the example below, the first 3 rows would not copy because the code put the date of copying in those rows. The next 3 would copy today and then insert today's date. This should have been solved long ago.

Date	Lead Code	Lead Name	YTD	Sales Code	Date Copied
8/01/23​	102​	Serengeti	2023​	201​	01/08/23​
8/01/23​	103​	Manyara	2023​	202​	01/08/23​
8/01/23​	104​	Mikumi	2023​	203​	01/08/23​
8/01/23​	105​	Serengeti	2023​	201​
8/02/23​	106​	Manyara	2023​	202​
8/03/23​	107​	Mikumi	2023​	203​

 

[MoonLove]

Hi Micron,

Where should I ran the code ? In consolidated mi report workbook or individual workbooks GK,SK,RJ and TB?.

Sub Copy_From_All_Workbooks()
Dim wb As String
Dim sh As Worksheet
Dim lngStartCopy As Long, Lrow As Long

RunMacro = Now + TimeValue("00:30:00")
Application.OnTime RunMacro, "Copy_From_All_Workbooks"
Application.ScreenUpdating = False
wb = Dir(ThisWorkbook.Path & "\*")
Do Until wb = ""
     If wb <> ThisWorkbook.Name Then
          Workbooks.Open ThisWorkbook.Path & "\" & wb
          For Each sh In Workbooks(wb).Worksheets
               lngStartCopy = sh.Cells(Rows.Count, "A").End(xlUp).Row + 1 'where to start copied range
               Lrow = sh.Cells(Rows.Count, "A").End(xlUp).Row 'where last row is with data in column A
              
               'if sheet is blank or flag/data is wrong, start row can be greater than end row
               If Not lngStartCopy > Lrow Then '
                    sh.Range("A" & lngStartCopy & ":A" & Lrow).EntireRow.Copy
                    ThisWorkbook.Sheets(sh.Name).Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues
                    Application.CutCopyMode = False
                    sh.Range("A" & lngStartCopy & ":A" & Lrow) = Date
               End If
          Next sh
          Workbooks(wb).Close False
     End If
wb = Dir
Loop

Application.ScreenUpdating = True

End Sub

 

[Micron]

Copy to a standard module. That code contains your edits and the reason it didn't work last time is that you made two code lines use A. When I told you to do that, it was based on understanding that column A was your flag column. Turns out it was not. The first line
lngStartCopy = sh.Cells(Rows.Count, "A")
has to use your flag column.

 

[MoonLove]

Hello Micron,

I run the below macro in consolidated mi report standard module however it just pull everything from my individual workbooks GK,SK,RJ and TB.


Where Iam getting it wrong? My flag column is column F(on each individual workbook GK,SK,RJ and TB).

Sub Copy_From_All_Workbooks()
Dim wb As String
Dim sh As Worksheet
Dim lngStartCopy As Long, Lrow As Long

'RunMacro = Now + TimeValue("00:30:00")
'Application.OnTime RunMacro, "Copy_From_All_Workbooks"
Application.ScreenUpdating = False
wb = Dir(ThisWorkbook.Path & "\*")
Do Until wb = ""
     If wb <> ThisWorkbook.Name Then
          Workbooks.Open ThisWorkbook.Path & "\" & wb
          For Each sh In Workbooks(wb).Worksheets
               lngStartCopy = sh.Cells(Rows.Count, "F").End(xlUp).Row + 1 'where to start copied range
               Lrow = sh.Cells(Rows.Count, "A").End(xlUp).Row 'where last row is with data in column A
              
               'if sheet is blank or flag/data is wrong, start row can be greater than end row
               If Not lngStartCopy > Lrow Then '
                    sh.Range("A" & lngStartCopy & ":A" & Lrow).EntireRow.Copy
                    ThisWorkbook.Sheets(sh.Name).Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues
                    Application.CutCopyMode = False
                    sh.Range("F" & lngStartCopy & ":F" & Lrow) = Date
               End If
          Next sh
          Workbooks(wb).Close False
     End If
wb = Dir
Loop

Application.ScreenUpdating = True

End Sub