VBA Code to Copy Data from Source Spreadsheet and Paste onto Destination Worksheet, based on condition

[tmsousa]

Hi everyone.

Thanks in advance for any help you might provide.

I'm looking to automate the creation of a PDF report which is based on an Excel file that I created. This Excel file (source file) generates figures which I intend to copy into another file (destination file) based on a condition.

To generate the figures, I have 2 variables which I input in 2 different cells:
- Product Model (All, Model1, Model2, Model3, Model4)
- Sales Region (All, Region_A, Region_B, Region_C, Region_D, Region_E, Region_F)

Every time I change the combination of the 2 variables, I have a cell which displays a unique combination (SKU) based on the variables values (All_All, All_Region_A,..., Model2_Region_F,...)

For every combination, based on the SKU, I want to be able to copy the generated data (which is already displayed in a dashboard(-ish) that covers a range: 10 rows by 14 columns) from the Source File and paste it as values into the Destination file. The Destination File already has all SKU possible combinations in one single column to match with the Source File SKU.

I guess my question is: is it at all possible to create a VBA code that does this automatically (including inputting values into the Product Model and Sales Region cells on the Source File)? My limited VBA knowledge tells me it's possible, but it doesn't even give me a starting point to write the code. I've played with the Recording Macro tool but I was not able to cover the dynamic aspect of looking for an SKU on Source file and matching it to the SKU on the Destination file.

I'm happy to provide a dummy file if it helps.

Cheers,
Tiago

 

[tmsousa]

In case anyone bumps into this thread and has a similar problem, I found a solution which applies to my specific scenario but it should be easy to adapt to other cases. It's not elegant but it does the job!

Sub Update_Data()

Dim FileToOpen As Variant 'TRUE of FALSE based on if file was open by user or not
    Dim i As Variant 'variable used to loop through ranges
    Dim counter As Integer 'variable used to loop through iterations
    Dim lr As Long 'last row of range to loop
    Dim r As Long 'row of each cell in the for loop that matches the condition
    Dim rng As Range 'range to loop
    Dim sourceWS As Worksheet 'data source
    Dim sourceSWS As Worksheet 'sheet in data source file with auxiliary calculations
    Dim sourceOBWS As Worksheet 'sheet in data source file with auxiliary calculations
    Dim destWS As Worksheet 'worksheet to paste the data to
   
   
    Set destWS = ThisWorkbook.Worksheets("Sheet1")
   
    lr = destWS.Cells(Rows.Count, 34).End(xlUp).Row 'elements to copy defined on column AH (number 34). this is a manually created column where I input an "X" in the row where I want data to be copied into
   
    Set rng = ThisWorkbook.Worksheets("Sheet1").Range("AH1:AH" & lr) 'range to loop in column AH
       
       
    Application.Calculation = xlAutomatic 'calculates entire workbook
    Application.Calculation = xlManual 'stops automatic calculation
   
    Application.ScreenUpdating = False 'stops screen from updating/flickering

        Set sourceWS = ThisWorkbook.Worksheets("Sheet1") 'data to import from ROPS sheet in ROPS planning tool file
        Set sourceSWS = ThisWorkbook.Worksheets("Sheet2") 'sheet in source file with auxiliary calculations
        Set sourceOBWS = ThisWorkbook.Worksheets("Sheet3") 'sheet in ROPS planning tool to calculate
                                         
                                         
            destWS.Range("C2").Copy
            sourceWS.Range("C2").PasteSpecial Paste:=xlPasteValues
            For Each i In rng 'copying values into report
                If i.Value = "x" Then
                    r = i.Row 'returns row number where i = "x"
                    counter = r - 3 'row number where sales region data is stored
                    destWS.Cells(counter, 3).Copy 'copies the sales region based on counter value'
                    sourceWS.Range("C3").PasteSpecial Paste:=xlPasteValues 'pastes the sales region in figures generator sheet
                    sourceWS.Range("A1:AF21").Calculate 'calculates necessary range
                    sourceSWS.Range("A1:AK85").Calculate 'calculates necessary range
                    sourceOBWS.Range("A1:AK85").Calculate 'calculates necessary range
                    sourceWS.Range("A1:AF21").Calculate 'calculates necessary range
                    sourceWS.Range("D9:AF19").Copy 'copy the generated figures
                    destWS.Cells(r, 4).PasteSpecial Paste:=xlPasteValues 'paste generated figures in the respective report section
                    counter = counter + 19
                End If
            Next i
           
            Application.CutCopyMode = False 'clears clipboard

    Application.ScreenUpdating = True 'resumes screen update in real time
   
End Sub

 

[Dan_W]

Hi - Sorry that no one had been able to help you sooner

 

[Dan_W]

Oops - I sent that prematurely - here is the full reply:
---------------------------------------------------------------------
Hi - Sorry that no one had been able to help you sooner, but well done for persevering and thank you for sharing your solution.

As regards your solution, now that I can see what it was you were aiming to accomplish in code, I was wondering whether there might be somethings you wanted to optimise. Also, if possible, I had some questions:

1. DestWS v SourceWS
In your code, this appears to point VBA to the same worksheet:

Set destWS = ThisWorkbook.Worksheets("Sheet1")
Set sourceWS = ThisWorkbook.Worksheets("Sheet1")

Also, after setting the various Source worksheets, the code states:

destWS.Range("C2").Copy
sourceWS.Range("C2").PasteSpecial Paste:=xlPasteValues

Assuming that these were, in fact, different worksheets this appears to me to be copying from the Destination Worksheet to the Source Worksheet, which I would have thought was the opposite direction of what you had intended.

2. Copy/Paste
In any event, for future reference, you probably don't need to be using copy/paste in your code at all, rather you can just assign the values to the destination cell. This will speed up your subroutine significantly. So, assuming you wanted the value from the sourceWS to go to the destWS, you could rewrite the lines of code I referenced in Point 1 above as:

destWS.Range("C2").Value = sourceWS.Range("C2").Value

There are a few other points in your code that could be optimised in this way, and I would be happy to help, but I first wanted to just check with you to see if you wanted any help and also to clarify a few additional points - I didn't want to bother you if you are happy with how it's working.

Thank you.

 

[tmsousa]

Oops - I sent that prematurely - here is the full reply:
---------------------------------------------------------------------
Hi - Sorry that no one had been able to help you sooner, but well done for persevering and thank you for sharing your solution.

As regards your solution, now that I can see what it was you were aiming to accomplish in code, I was wondering whether there might be somethings you wanted to optimise. Also, if possible, I had some questions:

1. DestWS v SourceWS
In your code, this appears to point VBA to the same worksheet:

Set destWS = ThisWorkbook.Worksheets("Sheet1")
Set sourceWS = ThisWorkbook.Worksheets("Sheet1")

Also, after setting the various Source worksheets, the code states:

destWS.Range("C2").Copy
sourceWS.Range("C2").PasteSpecial Paste:=xlPasteValues

Assuming that these were, in fact, different worksheets this appears to me to be copying from the Destination Worksheet to the Source Worksheet, which I would have thought was the opposite direction of what you had intended.

2. Copy/Paste
In any event, for future reference, you probably don't need to be using copy/paste in your code at all, rather you can just assign the values to the destination cell. This will speed up your subroutine significantly. So, assuming you wanted the value from the sourceWS to go to the destWS, you could rewrite the lines of code I referenced in Point 1 above as:

destWS.Range("C2").Value = sourceWS.Range("C2").Value

There are a few other points in your code that could be optimised in this way, and I would be happy to help, but I first wanted to just check with you to see if you wanted any help and also to clarify a few additional points - I didn't want to bother you if you are happy with how it's working.

Thank you.

Hi Dan,

Thank you for your reply.

I do see a lot of improvements / optimisation opportunities, but I guess this was the only logic that I could translate from my brain to VBA code

1. DestWS v SourceWS - this was a typo when anonymising the code! They are indeed different sheets. As for copying from DestWS to SourceWS, this is what I want as I have a hardcoded product in DestWS to copy and paste to SourceWS which will calculate the KPIs for that procuct.

2. Copy/Paste - you're 100% right, I could and should've set the values instead of copying / pasting...

In the meantime, I had to re-write the code and add some functionality, as I have conditional formatting on SourceWS which I want to bring across to DestWS (just the text colour, not the actual conditional formatting).

In summary, what I'm trying to achieve is to only maintain the KPIs calculator sheet (SourceWS) for 1 scenario (1 product + sales region combination), while being able to calculate KPIs for all the possible scenarios (5 products, 13 sales regions, so 65 different combinations). This will make it much easier for me to update the KPIs calculator sheet (SourceWS) in case I'm asked to add more KPIs, change calculation methods, change time granularity, add more products/regions,...

So when adding the functionality of copying the cells formatting + cells values, I came up this:

Sub Update_Rops()

    Dim y As Variant 'variable used to loop through ranges, as well as giving the program a row reference of where to paste the data to
    Dim i As Integer 'variable used to loop through ranges
    Dim j As Integer 'variable used to loop through ranges
    Dim counter As Integer 'variable used to loop through model iterations
    Dim lr As Long 'last row of range to loop
    Dim r As Long 'row of each cell in the for loop that matches the condition
    Dim rng As Range 'range to loop
    Dim sourceWS As Worksheet 'ROPS planning tool ROPS sheet which calculates all KPIs
    Dim sourceSWS As Worksheet 'ROPS planning tool KPI8 sheet which is an auxiliary calculation sheet
    Dim sourceOBWS As Worksheet 'ROPS planning tool KPI9 sheet which is an auxiliary calculation sheet
    Dim destWS As Worksheet 'report worksheet
    
    
    Set destWS = ThisWorkbook.Worksheets("ROPS Dashboard") 'report sheet
    
    lr = destWS.Cells(Rows.Count, 34).End(xlUp).Row 'elements to loop through defined in column AH (number 34);
    
    Set rng = ThisWorkbook.Worksheets("ROPS Dashboard").Range("AH1:AH" & lr) 'range to loop in column AH
        
        
    Application.Calculation = xlAutomatic 'calculates entire workbook before running the code
    Application.Calculation = xlManual 'stops automatic calculation to speed up the code
    
    Application.ScreenUpdating = False 'stops screen from updating/flickering
    
    destWS.Range("C2").Copy 'copy region chosen by user. for this report, it will be the same region for all 5 scenarios, but I have another report where the region changes for every scenario because it is not a user input
    destWS.Range("C21").PasteSpecial Paste:=xlPasteValues 'paste region chosen by user for the 2nd product
    destWS.Range("C40").PasteSpecial Paste:=xlPasteValues 'paste region chosen by user for the 3rd product
    destWS.Range("C59").PasteSpecial Paste:=xlPasteValues 'paste region chosen by user for the 4th product
    destWS.Range("C78").PasteSpecial Paste:=xlPasteValues 'paste region chosen by user for the 5th product

        Set sourceWS = ThisWorkbook.Worksheets("ROPS") 'data to import from ROPS sheet (KPIs calculator)
        Set sourceSWS = ThisWorkbook.Worksheets("KPI8") 'sheet to calculate KPI1
        Set sourceOBWS = ThisWorkbook.Worksheets("KPI9") 'sheet to calculate KPI2
                                          
                                          
            destWS.Range("C2").Copy 'copy region chosen by user
            sourceWS.Range("C2").PasteSpecial Paste:=xlPasteValues 'paste region chosen by user in the KPI calculator sheet
            For Each y In rng 'copying values into 2021 regions report
                If y.Value = "x" Then 'these "x" were manully added in column AH. I probably can use some of the data in the other columns as a reference
                    r = y.Row
                    counter = r - 3 'the product is always 3 rows above the "x" row, so counter will give me the row number to copy the different products into the 
                    destWS.Cells(counter, 3).Copy 'copies the relevant product (the 5 different products are hardcoded in cells C3, C22, C41, C60 and C79)
                    sourceWS.Range("C3").PasteSpecial Paste:=xlPasteValues 'pastes the product in KPI calculator sheet
                    sourceWS.Range("A1:AF21").Calculate 'calculate necessary range
                    sourceSWS.Range("A1:AK85").Calculate 'calculate necessary range
                    sourceOBWS.Range("A1:AK85").Calculate 'calculate necessary range
                    sourceWS.Range("A1:AF21").Calculate 'calculate necessary range
                        
                        i = 0
                        j = 4
                        For i = 0 To 10 
                            For j = 4 To 32 'cell by cell in range "D9:AF19" SourceWS, I need the value and the formatting to copy to the relevant report section in DestWS
                                destWS.Cells(i + r, j).Value = sourceWS.Cells(i + 9, j).Value 'data on SourceWS is always at row 9+i (9,10,11,...19) and paste region on DestWS is always i+r (6,7,8,...,16; 25, 26,... 35; 44, 45,... 54:.....)
                                
                                    If sourceWS.Cells(i + 9, j).DisplayFormat.Font.ColorIndex = 9 Then 'checks if cell colour is red, if so, make that cell red on destWS
                                        destWS.Cells(i + r, j).Font.ColorIndex = 9 
                                        destWS.Cells(i + r, j).Font.Italic = False
                                        destWS.Cells(i + r, j).Font.Bold = False
                                        
                                    ElseIf sourceWS.Cells(i + 9, j).DisplayFormat.Font.ColorIndex = 10 Then 'checks if cell colour is green, if so, make that cell green on destWS
                                        destWS.Cells(i + r, j).Font.ColorIndex = 10
                                        destWS.Cells(i + r, j).Font.Italic = False
                                        destWS.Cells(i + r, j).Font.Bold = False
                                        
                                    ElseIf sourceWS.Cells(i + 9, j).DisplayFormat.Font.ColorIndex = 16 Then 'checks if cell colour is gray, if so, make that cell gray on destWS
                                        destWS.Cells(i + r, j).Font.ColorIndex = 16
                                        destWS.Cells(i + r, j).Font.Italic = True
                                        destWS.Cells(i + r, j).Font.Bold = False
                                        
                                    Else
                                        destWS.Cells(i + r, j).Font.ColorIndex = 1 'if the cell is not red, green or gray, then remove italics and bolds from DestWS formatting and leave the colour as it is on DestWS
                                        destWS.Cells(i + r, j).Font.Italic = False
                                        destWS.Cells(i + r, j).Font.Bold = False
                                    End If
                            Next j
                        Next i
                    
                    counter = counter + 19 'next scenario is 19 rows below the current scenario (this means that there are 19 rows between each "x" in column AH), so potentially this could be a dynamic value rather than a hardcoded 19
                End If
            Next y
            
            Application.CutCopyMode = False 'clears clipboard

    Application.ScreenUpdating = True 'resumes screen update in real time
    
    destWS.Activate
    destWS.Range("Q1:Q" & lr).Font.Bold = True 'make totals column bold for year 1
    destWS.Range("AF1:AF" & lr).Font.Bold = True 'make totals column bold for year 2
    destWS.Range("C2").Select 'select region input cell to have the user back at where they started
    
    
End Sub

I hope the commentary helps to explain the problem! I can definitely see some opportunities to make the code more dynamic, I just don't know how to do it as my VBA knowledge and experience are very limited... All suggestions are very much welcome!

Cheers,
Tiago