Solved

VB Code required to do copy/paste?

Posted on 2008-06-16
11
649 Views
Last Modified: 2011-10-19
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
0
Comment
Question by:ketkana
  • 6
  • 4
11 Comments
 
LVL 13

Expert Comment

by:Corey2
ID: 21799431
Look up conditional formatting for starters.  That will take care of the colouring portion.  Formating>Conditional Formatting
0
 
LVL 1

Expert Comment

by:unikarthik
ID: 21802056
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
 

Author Comment

by:ketkana
ID: 21802597
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
 
LVL 1

Expert Comment

by:unikarthik
ID: 21802999
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
 

Author Comment

by:ketkana
ID: 21803993
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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 1

Expert Comment

by:unikarthik
ID: 21805324
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
 
LVL 1

Expert Comment

by:unikarthik
ID: 21805747
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
 
LVL 1

Expert Comment

by:unikarthik
ID: 21821317
Ket, what happened any updates on my code
0
 

Author Comment

by:ketkana
ID: 21822001
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
 
LVL 1

Accepted Solution

by:
unikarthik earned 500 total points
ID: 21828775
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
 

Author Comment

by:ketkana
ID: 21829842
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

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction While answering a recent question (http:/Q_27311462.html), I created an alternative function to the Excel Concatenate() function that you might find useful.  I tested several solutions and share the results in this article as well as t…
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

896 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now