Solved

VB Code required to do copy/paste?

Posted on 2008-06-16
11
648 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
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 
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

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Suggested Solutions

Convert between Excel file formats (.XLS, .XLSX, .XLSM) with/without macro option David Miller (dlmille) Intro Over this past Fall, I've had the opportunity to see several similar requests and have developed a couple related solutions associate…
This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
The viewer will learn how to simulate a series of coin tosses with the rand() function and learn how to make these “tosses” depend on a predetermined probability. Flipping Coins in Excel: Enter =RAND() into cell A2: Recalculate the random variable…
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

708 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

17 Experts available now in Live!

Get 1:1 Help Now