VB Code required to do copy/paste?

Hello Experts,

I have attached a sample workbook. It contains a summary tab and other tabs that contain data. What I require is a formula or code that will take the information from the first country tab (In this example 'Corporate'), copy all the rows of data into the summary sheet and then look at column E which is a date. The formula/code then has to look at the month in the date and then colour/shade the relevant month cell in that row.
Then the formula code must copy all the data from the next tab and paste it in the summary sheet directly under the first set of data that was previously pasted. It then needs to repeat the process of looking at the date and colouring/shading the relevant month cell in the row and so on and so forth.

I have no idea where to even start with this so any and all help extremely appreciated.

Thanks

Ket, London (UK)
EMEA-Marketing-Planner-2008-EXAM.xls
ketkanaAsked:
Who is Participating?

[Webinar] Streamline your web hosting managementRegister Today

x
 
unikarthikConnect With a Mentor Commented:
Ket,
  Use this updated code. This will resolve the 12 rows gap. Let me know and thanks for the points
  Answers:
  1. Yes. you can add n-sheets this is coded such way that it will pick the sheets in run time only. So no issues.
3. The code will automatically override the previous data and paste the new one only. So I believe no need of manual intervention.
2.  I am not clear on this.
Sub EMEA_Market()
Application.ScreenUpdating = False
For sheetcnt = 1 To Sheets.Count - 1
    Sheets(sheetcnt + 1).Activate
    lstrw = ActiveSheet.Range("A65536").End(xlUp).Row
    Range("A4:L" & lstrw & Chr(32)).Select
    Selection.Copy
    Sheets(1).Activate
    lstcll = ActiveSheet.Range("A65536").End(xlUp).Row
    Cells(lstcll + 1, 1).Select
    ActiveSheet.Paste
    clrindx = 34
    cnt = 1
    For i = 4 To ActiveSheet.Range("A65536").End(xlUp).Row
      Select Case Month(Cells(i, 5).Value)
         Case 1:
              Cells(i, 13).Select
              With Selection.Interior
                    .ColorIndex = 10
                    .Pattern = xlSolid
              End With
       
          Case 2:
                 Cells(i, 14).Select
              With Selection.Interior
                    .ColorIndex = 11
                    .Pattern = xlSolid
              End With
       
        Case 3:
                 Cells(i, 15).Select
              With Selection.Interior
                    .ColorIndex = 12
                    .Pattern = xlSolid
              End With
       
        Case 4:
              Cells(i, 16).Select
              With Selection.Interior
                    .ColorIndex = 13
                    .Pattern = xlSolid
              End With
       
        Case 5:
              Cells(i, 17).Select
              With Selection.Interior
                    .ColorIndex = 14
                    .Pattern = xlSolid
              End With
       
        Case 6:
              Cells(i, 18).Select
              With Selection.Interior
                    .ColorIndex = 15
                    .Pattern = xlSolid
              End With
       
        Case 7:
              Cells(i, 19).Select
              With Selection.Interior
                    .ColorIndex = 16
                    .Pattern = xlSolid
              End With
       
        Case 8:
              Cells(i, 20).Select
              With Selection.Interior
                    .ColorIndex = 17
                    .Pattern = xlSolid
              End With
       
        Case 9:
              Cells(i, 21).Select
              With Selection.Interior
                    .ColorIndex = 18
                    .Pattern = xlSolid
              End With
       
        Case 10:
              Cells(i, 22).Select
              With Selection.Interior
                    .ColorIndex = 19
                    .Pattern = xlSolid
              End With
       
        Case 11:
              Cells(i, 23).Select
              With Selection.Interior
                    .ColorIndex = 20
                    .Pattern = xlSolid
              End With
       
        Case 12:
              Cells(i, 24).Select
              With Selection.Interior
                    .ColorIndex = 21
                    .Pattern = xlSolid
              End With

       
       
        End Select
   
    Next i
   
    Application.ScreenUpdating = True
Next sheetcnt
End Sub

0
 
Corey ScheichDeveloperCommented:
Look up conditional formatting for starters.  That will take care of the colouring portion.  Formating>Conditional Formatting
0
 
unikarthikCommented:
Try to use this code. I have hard coded for only one sheet. Just let me the is what you are looking for. Will custom the code later.

Sub test()
Application.ScreenUpdating = False
Sheets(2).Activate
lstrw = ActiveCell.SpecialCells(xlLastCell).Row
Range("A4:L" & lstrw & Chr(32)).Select
Selection.Copy
Sheets(1).Activate
Cells(4, 1).Select
ActiveSheet.Paste
clrindx = 34
cnt = 1
For i = 4 To ActiveCell.SpecialCells(xlLastCell).Row - 1
       Cells(i, 5).Select
      If Selection.Interior.ColorIndex = xlNone Then
        orgndte = Cells(i, 5).Value
      Else
         i = i + 1
         orgndte = Cells(i, 5).Value
         clrindx = 34 + cnt
   
      End If
 For j = i + 1 To ActiveCell.SpecialCells(xlLastCell).Row - 1
        If Month(orgndte) = Month(Cells(j, 5).Value) Then
          Cells(i, 5).Select
           With Selection.Interior
                .ColorIndex = clrindx
                .Pattern = xlSolid
          End With
          Cells(j, 5).Select
           With Selection.Interior
                .ColorIndex = clrindx
                .Pattern = xlSolid
          End With
       ElseIf Cells(j, 5).Value = "" Then Exit For
       End If
 Next j
 clrindx = 34 + cnt
 cnt = cnt + 1
Next i

Application.ScreenUpdating = True
End Sub
0
Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
ketkanaAuthor Commented:
Unikarthik,

Wow! Almost what I require. From the sample workbook, you can see that columns M to X are the days of the month. What I require the code to do is look at month value in column E, and colour the corresponding month cell in columns M to X.

For example, E7 is March. I would like cell O7 coloured to show this.

Apologies for the lengthy response and thank you so much for your assistance.

Ket
0
 
unikarthikCommented:
Hi Ket,
  try this code. I have harded for 2 months only. Let me know it works or not . Then I will give you the uopdated code.
Sub test()
Application.ScreenUpdating = False
Sheets(2).Activate
lstrw = ActiveCell.SpecialCells(xlLastCell).Row
Range("A4:L" & lstrw & Chr(32)).Select
Selection.Copy
Sheets(1).Activate
Cells(4, 1).Select
ActiveSheet.Paste
clrindx = 34
cnt = 1
For i = 4 To ActiveCell.SpecialCells(xlLastCell).Row - 1
  Select Case Month(Cells(i, 5).Value)
     Case 1:
          Cells(i, 13).Select
          With Selection.Interior
                .ColorIndex = 34
                .Pattern = xlSolid
          End With
   
      Case 2:
             Cells(i, 14).Select
          With Selection.Interior
                .ColorIndex = 35
                .Pattern = xlSolid
          End With
    End Select

Next i

Application.ScreenUpdating = True
End Sub
0
 
ketkanaAuthor Commented:
That is fantastic! Exactly what is required. Maybe a cheeky question, Unikarthik, but on the basis that this can work for all worksheets, is there anything you could put in the coding that would allow the data filters to function?

For example, the Macro is run and all cells are coloured accordingly. Could I then choose one of the filters to only show me January?
If you can, then great. If not, I really appreciate your assistance and help.

Ket
0
 
unikarthikCommented:
Ket, I am not getting what exactly at the end you require in the macro. If you could brief me, will try for that.
Karthik
0
 
unikarthikCommented:
Ket,
   This is the final code. This will do the magic u needed. Let me know it works fine or not.

Sub EMEA_Market()
Application.ScreenUpdating = False
For sheetcnt = 1 To Sheets.Count - 1
    Sheets(sheetcnt + 1).Activate
    lstrw = ActiveCell.SpecialCells(xlLastCell).Row
    Range("A4:L" & lstrw & Chr(32)).Select
    Selection.Copy
    Sheets(1).Activate
    lstcll = ActiveCell.SpecialCells(xlLastCell).Row
    Cells(lstcll + 1, 1).Select
    ActiveSheet.Paste
    clrindx = 34
    cnt = 1
    For i = 4 To ActiveCell.SpecialCells(xlLastCell).Row
      Select Case Month(Cells(i, 5).Value)
         Case 1:
              Cells(i, 13).Select
              With Selection.Interior
                    .ColorIndex = 10
                    .Pattern = xlSolid
              End With
       
          Case 2:
                 Cells(i, 14).Select
              With Selection.Interior
                    .ColorIndex = 11
                    .Pattern = xlSolid
              End With
       
        Case 3:
                 Cells(i, 15).Select
              With Selection.Interior
                    .ColorIndex = 12
                    .Pattern = xlSolid
              End With
       
        Case 4:
              Cells(i, 16).Select
              With Selection.Interior
                    .ColorIndex = 13
                    .Pattern = xlSolid
              End With
       
        Case 5:
              Cells(i, 17).Select
              With Selection.Interior
                    .ColorIndex = 14
                    .Pattern = xlSolid
              End With
       
        Case 6:
              Cells(i, 18).Select
              With Selection.Interior
                    .ColorIndex = 15
                    .Pattern = xlSolid
              End With
       
        Case 7:
              Cells(i, 19).Select
              With Selection.Interior
                    .ColorIndex = 16
                    .Pattern = xlSolid
              End With
       
        Case 8:
              Cells(i, 20).Select
              With Selection.Interior
                    .ColorIndex = 17
                    .Pattern = xlSolid
              End With
       
        Case 9:
              Cells(i, 21).Select
              With Selection.Interior
                    .ColorIndex = 18
                    .Pattern = xlSolid
              End With
       
        Case 10:
              Cells(i, 22).Select
              With Selection.Interior
                    .ColorIndex = 19
                    .Pattern = xlSolid
              End With
       
        Case 11:
              Cells(i, 23).Select
              With Selection.Interior
                    .ColorIndex = 20
                    .Pattern = xlSolid
              End With
       
        Case 12:
              Cells(i, 24).Select
              With Selection.Interior
                    .ColorIndex = 21
                    .Pattern = xlSolid
              End With

       
       
        End Select
   
    Next i
   
    Application.ScreenUpdating = True
Next sheetcnt
End Sub
0
 
unikarthikCommented:
Ket, what happened any updates on my code
0
 
ketkanaAuthor Commented:
Hi Unikarthik, Apologies for the delay in response. OK, so the code works to a degree.
When I run it for the first time, the data is collected from the other sheets in the workbook, pasted into the summary sheet and colour coded.
So far so good. For some reason, there is a 12 row gap between the corporate data and the Belgium data in the summary sheet. If the gap can be removed, then we are almost there.
My final questions would be:
1.What if our Marketing team decide to add further worksheets to this workbook for other countries. Can these be automatically included in the copy/paste/color macro to the summary sheet?
2.Once all the data is in the summary sheet, can filters be used on the colours? Can we assign a hidden number to each color so it can be data sorted?
3. As this workbook is continuously updated, can the macro be set so that it removes all previous data from the summary sheet prior to pasting the updated data or does this need to be done manually?

Thanks again so much for devoting some time to this.
0
 
ketkanaAuthor Commented:
Unikarthik,
Amazing! I wish I knew VB! Thanks for your efforts with this. I have run the macro and on first pass the data is transferred correctly.
I ran it twice to see if the original data was overwritten. It would appear that the macro is not overriding the previous data but appending it to the bottom of the previous list.
What I meant by my question reference 2 was that you will see that the summary worksheet has data filters. When the macro is run, a cell relating to the month is coloured in, for example January is Dark green.
Can I then use the data filter for January so all Jan entries can be sorted. The same for the other months. My idea was that when the macro colours the cell it also places a number in it for example 1 for Jan 2 for march etc. The data filter could then be used to sort by the numbers.

I appreciate all the assistance you have provided so far and feel terrible in asking additional questions. I totally understand if this is not possible.

Thanks once again.
0
All Courses

From novice to tech pro — start learning today.