Email:      Pass:    Pass?
Advertisements


Free Excel Forum

Copying Value And Format Of Cell To New Worksheet In New Workbook

Forum Register
Search Excel Forum Posts, Tutorials, Macros, Tips, and More

I have created a macro to copy cell values from a worksheet in a master workbook to templates I have created in another workbook using the following code:

Sub ChangeControlTransfer(wsPMOToolMaster As Worksheet, iMst As Integer, wsPMOToolTemplate As Worksheet, ByRef iWorkstream As Integer)

'ID
wsPMOToolTemplate.Cells(iWorkstream, 1).Value = wsPMOToolMaster.Cells(iMst, 1).Value
'Change Control Received
wsPMOToolTemplate.Cells(iWorkstream, 2).Value = wsPMOToolMaster.Cells(iMst, 2).Value
'Plainview #
wsPMOToolTemplate.Cells(iWorkstream, 3).Value = wsPMOToolMaster.Cells(iMst, 3).Value
'Name of Requestor
wsPMOToolTemplate.Cells(iWorkstream, 4).Value = wsPMOToolMaster.Cells(iMst, 4).Value
'Workstream
wsPMOToolTemplate.Cells(iWorkstream, 5).Value = wsPMOToolMaster.Cells(iMst, 5).Value
'Workstream Subtype
wsPMOToolTemplate.Cells(iWorkstream, 6).Value = wsPMOToolMaster.Cells(iMst, 6).Value
'Event Type
wsPMOToolTemplate.Cells(iWorkstream, 7).Value = wsPMOToolMaster.Cells(iMst, 7).Value

>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
I then call this procedure in another procedure. My question is: can I modify this code to also copy the cell format (highlighting, font, borders, etc)? Thank you for your time


Similar Excel Video Tutorials

Helpful Excel Macros

Format Cells as Time in Excel
- This free Excel macro formats a selection of cells in the Time format in Excel. This Time number format means that inst
Format Cells in The Short Date Number Format in Excel
- This free Excel macro applies the Short Date number format to a selection of cells in Excel. This number format display
Highlight Cells which Contain Formulas
- This macro will highlight all of the cells in a worksheet which contain a formula. The first one listed will highlight
Format Cells as a Fraction in Excel Number Formatting
- This free Excel macro will automatically format a selected cell or many selected cells in the Fraction number format in
Format Cells in The Number (Numerical) Number Format in Excel
- This free Excel macro formats selected cells in the Number or Numerical number format in Excel. This means that the cel

Similar Topics







I am using some code to find a lowest cost amongst cells that contain stock. if a cell doesn't contain stock, then the variable is not assigned anything. Yet, i must test all variables in the min function because i will not always know what has stock and what doesn't.
When the variables are left blank, the min returns 0, even though 0 is not stored in the variable. Stepping line by line, the variable returns empty in the code, but 0 after running the min function...

Code:

If cell.Offset(0, 4) > 0 Then
        Set imco = cell.Offset(0, 3)
        Set imst = cell.Offset(0, 4)
        End If
        If cell.Offset(0, 6) > 0 Then
        Set tdco = cell.Offset(0, 5)
        Set tdst = cell.Offset(0, 6)
        End If
        If cell.Offset(0, 8) > 0 Then
        Set syco = cell.Offset(0, 7)
        Set syst = cell.Offset(0, 8)
        End If
        If cell.Offset(0, 10) > 0 Then
        Set wyco = cell.Offset(0, 9)
        Set wyst = cell.Offset(0, 10)
        End If
        If cell.Offset(0, 12) > 0 Then
        Set dhco = cell.Offset(0, 11)
        Set dhst = cell.Offset(0, 12)
        End If
        If cell.Offset(0, 14) > 0 Then
        Set cpco = cell.Offset(0, 13)
        Set cpst = cell.Offset(0, 14)
        End If
 
        mincost = Application.WorksheetFunction.Min(imco, tdco, syco, wyco, dhco, cpco)
        MsgBox mincost





So thanks to a user on this forum, I was able to develop code to pull data that was always on the same sheet and in the same cell from about 100 workbooks. It takes about 30 seconds per workbook (about an hour total) to get 98 values from each. I was initially using 2007 but now use 2003.
Is this as good as it can get? Suggestions for speeding it up? i tried to deactivate the screen refreshing, but I always got an error or it would freeze while running the code.

A bit of background on what the code does just in case: Each Client of my company has its own spreadsheet where cases (like a law firm) are entered to keep track of cases opened, closed, duration, etc. Each column tracks a different stat and there are 7 rows (25-31) for 7 years over which I am tracking data. The Master spreadsheet has this macro attached to it so that it can pull all the stats from all of our clients to combine them all together. Currently we have about 100 clients.



Sub PullStats()
Dim z As Long, e As Long
Dim f As String
d = 2
Cells(1, 1) = "=cell(""filename"")"
Cells(1, 2) = "=left(A1,find(""["",A1)-1)"
On Error Resume Next
Cells(2, 1).Select
f = Dir(Cells(1, 2) & "*.xls")
Do While Len(f) > 0
ActiveCell.Formula = f
ActiveCell.Offset(1, 0).Select
f = Dir()
Loop
z = Cells(Rows.Count, 1).End(xlUp).Row
For e = 2 To z
If Cells(e, 1) ActiveWorkbook.Name Then
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!C25"
Cells(e, 2) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!C26"
Cells(e, 3) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!C27"
Cells(e, 4) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!C28"
Cells(e, 5) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!C29"
Cells(e, 6) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!C30"
Cells(e, 7) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!C31"
Cells(e, 8) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!D25"
Cells(e, 9) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!D26"
Cells(e, 10) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!D27"
Cells(e, 11) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!D28"
Cells(e, 12) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!D29"
Cells(e, 13) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!D30"
Cells(e, 14) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!D31"
Cells(e, 15) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!N25"
Cells(e, 16) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!N26"
Cells(e, 17) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!N27"
Cells(e, 18) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!N28"
Cells(e, 19) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!N29"
Cells(e, 20) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!N30"
Cells(e, 21) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!N31"
Cells(e, 22) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!F25"
Cells(e, 23) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!F26"
Cells(e, 24) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!F27"
Cells(e, 25) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!F28"
Cells(e, 26) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!F29"
Cells(e, 27) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!F30"
Cells(e, 28) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!F31"
Cells(e, 29) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!G25"
Cells(e, 30) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!G26"
Cells(e, 31) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!G27"
Cells(e, 32) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!G28"
Cells(e, 33) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!G29"
Cells(e, 34) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!G30"
Cells(e, 35) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!G31"
Cells(e, 36) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!P25"
Cells(e, 37) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!P26"
Cells(e, 38) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!P27"
Cells(e, 39) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!P28"
Cells(e, 40) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!P29"
Cells(e, 41) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!P30"
Cells(e, 42) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!P31"
Cells(e, 43) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!M25"
Cells(e, 44) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!M26"
Cells(e, 45) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!M27"
Cells(e, 46) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!M28"
Cells(e, 47) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!M29"
Cells(e, 48) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!M30"
Cells(e, 49) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!M31"
Cells(e, 50) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!O25"
Cells(e, 51) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!O26"
Cells(e, 52) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!O27"
Cells(e, 53) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!O28"
Cells(e, 54) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!O29"
Cells(e, 55) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!O30"
Cells(e, 56) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!O31"
Cells(e, 57) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!I25"
Cells(e, 58) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!I26"
Cells(e, 59) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!I27"
Cells(e, 60) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!I28"
Cells(e, 61) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!I29"
Cells(e, 62) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!I30"
Cells(e, 63) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!I31"
Cells(e, 64) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!J25"
Cells(e, 65) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!J26"
Cells(e, 66) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!J27"
Cells(e, 67) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!J28"
Cells(e, 68) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!J29"
Cells(e, 69) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!J30"
Cells(e, 70) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!J31"
Cells(e, 71) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!K25"
Cells(e, 72) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!K26"
Cells(e, 73) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!K27"
Cells(e, 74) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!K28"
Cells(e, 75) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!K29"
Cells(e, 76) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!K30"
Cells(e, 77) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!K31"
Cells(e, 78) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!L25"
Cells(e, 79) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!L26"
Cells(e, 80) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!L27"
Cells(e, 81) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!L28"
Cells(e, 82) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!L29"
Cells(e, 83) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!L30"
Cells(e, 84) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!L31"
Cells(e, 85) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!Q25"
Cells(e, 86) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!Q26"
Cells(e, 87) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!Q27"
Cells(e, 88) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!Q28"
Cells(e, 89) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!Q29"
Cells(e, 90) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!Q30"
Cells(e, 91) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!Q31"
Cells(e, 92) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!R25"
Cells(e, 93) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!R26"
Cells(e, 94) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!R27"
Cells(e, 95) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!R28"
Cells(e, 96) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!R29"
Cells(e, 97) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!R30"
Cells(e, 98) = Cells(1, 98)
Cells(1, 98) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Location Stats'!R31"
Cells(e, 99) = Cells(1, 98)
End If
Next e
MsgBox "Compilation is complete."
End Sub


I have a workbook which contains three worksheets

Data = worksheet 1
M03Map = worksheet 2
M03 = worksheet 3


I would like the main data entry sheet to feed both the M03Map and M03 (Calculations) worksheet.

Can I write a single macro to have the Data sheet feed both of the other sheets? This is what I have written thus far, but when I go to run the macro, the Run button is grayed out and I am not able to run it. I'm guessing that somewhere I violated some rules of the code.


Sub M03()
' Dim X As Integer
Dim N As Integer

Dim Data As Worksheet
Dim M03Map As Worksheet
Dim M03 As Worksheet

Set Data = Worksheets("Data")
Set M03Map = Worksheets("M03Map")
Set M03 = Worksheets("M03")

Interns.Activate

N = ActiveCell.Row

For X = 1 To 256
Select Case X
Case 1
M03Map.Cells(6, 3) = Data.Cells(N, 2) 'Date
Case 2
M03Map.Cells(6, 3) = Data.Cells(N, 4) 'Shift
Case 3
M03Map.Cells(18, 8) = Data.Cells(N, 5) 'Scheduler
Case 4
M03Map.Cells(20, 8) = Data.Cells(N, 6) 'Tech Support
Case 5
M03Map.Cells(22, 8) = Data.Cells(N, 7) 'S/u#1
Case 6
M03Map.Cells(24, 8) = Data.Cells(N, 8) 'S/u#2
Case 7
M03Map.Cells(26, 3) = Data.Cells(N, 9) '6S
Case 8
M03Map.Cells(22, 3) = Data.Cells(N, 11) 'Machine(1) Loader
Case 9
M03Map.Cells(23, 3) = Data.Cells(N, 12) 'Machine(1) Backup
Case 10
M03Map.Cells(24, 3) = Data.Cells(N, 13) 'Machine(1) Inspector
Case 11
M03Map.Cells(17, 3) = Data.Cells(N, 14) 'Job#1
Case 12
M03Map.Cells(18, 3) = Data.Cells(N, 15) 'W.O. Qty
Case 13
M03Map.Cells(19, 3) = Data.Cells(N, 16) 'Lot
Case 14
M03Map.Cells(20, 3) = Data.Cells(N, 17) 'Op
Case 15
M03Map.Cells(21, 3) = Data.Cells(N, 18) 'MPP
Case 16
M03Map.Cells(17, 5) = Data.Cells(N, 19) 'Job#2
Case 17
M03Map.Cells(18, 5) = Data.Cells(N, 20) 'W.O. Qty
Case 18
M03Map.Cells(18, 5) = Data.Cells(N, 21) 'Lot
Case 19
M03Map.Cells(18, 5) = Data.Cells(N, 22) 'Op
Case 20
M03Map.Cells(18, 5) = Data.Cells(N, 23) 'MPP
Case 21
M03Map.Cells(13, 8) = Data.Cells(N, 46) 'Machine(2) Loader
Case 22
M03Map.Cells(14, 8) = Data.Cells(N, 47) 'Machine(2) Backup
Case 23
M03Map.Cells(15, 8) = Data.Cells(N, 48) 'Machine(2) Inspector
Case 24
M03Map.Cells(8, 8) = Data.Cells(N, 49) 'Job#1
Case 25
M03Map.Cells(9, 8) = Data.Cells(N, 50) 'W.O. Qty
Case 26
M03Map.Cells(10, 8) = Data.Cells(N, 51) 'Lot
Case 27
M03Map.Cells(11, 8) = Data.Cells(N, 52) 'Op
Case 28
M03Map.Cells(12, 8) = Data.Cells(N, 53) 'MPP
Case 29
M03Map.Cells(8, 10) = Data.Cells(N, 54) 'Job#2
Case 30
M03Map.Cells(9, 10) = Data.Cells(N, 55) 'W.O. Qty
Case 31
M03Map.Cells(10, 10) = Data.Cells(N, 56) 'Lot
Case 32
M03Map.Cells(11, 10) = Data.Cells(N, 57) 'Op
Case 33
M03Map.Cells(12, 10) = Data.Cells(N, 58) 'MPP
Case 34
M03Map.Cells(6, 3) = Data.Cells(N, 81) 'Machine(3) Loader
Case 35
M03Map.Cells(6, 3) = Data.Cells(N, 82) 'Machine(3) Backup
Case 36
M03Map.Cells(6, 3) = Data.Cells(N, 83) 'Machine(3) Inspector
Case 37
M03Map.Cells(17, 13) = Data.Cells(N, 84) 'Job#1
Case 38
M03Map.Cells(18, 13) = Data.Cells(N, 85) 'W.O. Qty
Case 39
M03Map.Cells(19, 13) = Data.Cells(N, 86) 'Lot
Case 40
M03Map.Cells(20, 13) = Data.Cells(N, 87) 'Op
Case 41
M03Map.Cells(21, 13) = Data.Cells(N, 88) 'MPP
Case 42
M03Map.Cells(17, 15) = Data.Cells(N, 89) 'Job#2
Case 43
M03Map.Cells(18, 15) = Data.Cells(N, 90) 'W.O. Qty
Case 44
M03Map.Cells(18, 15) = Data.Cells(N, 91) 'Lot
Case 45
M03Map.Cells(19, 15) = Data.Cells(N, 92) 'Op
Case 46
M03Map.Cells(20, 15) = Data.Cells(N, 93) 'MPP
Case 47
M03Map.Cells(6, 3) = Data.Cells(N, 116) 'Machine(4) Loader
Case 48
M03Map.Cells(6, 3) = Data.Cells(N, 117) 'Machine(4) Backup
Case 49
M03Map.Cells(6, 3) = Data.Cells(N, 118) 'Machine(4) Inspector
Case 50
M03Map.Cells(28, 13) = Data.Cells(N, 119) 'Job#1
Case 51
M03Map.Cells(29, 13) = Data.Cells(N, 120) 'W.O. Qty
Case 52
M03Map.Cells(30, 13) = Data.Cells(N, 121) 'Lot
Case 53
M03Map.Cells(31, 13) = Data.Cells(N, 122) 'Op
Case 54
M03Map.Cells(32, 13) = Data.Cells(N, 123) 'MPP
Case 55
M03Map.Cells(28, 15) = Data.Cells(N, 124) 'Job#2
Case 56
M03Map.Cells(29, 15) = Data.Cells(N, 125) 'W.O. Qty
Case 57
M03Map.Cells(30, 15) = Data.Cells(N, 126) 'Lot
Case 58
M03Map.Cells(31, 15) = Data.Cells(N, 127) 'Op
Case 59
M03Map.Cells(32, 15) = Data.Cells(N, 128) 'MPP
Case 60
M03.Cells(1, 30) = Data.Cells(N, 2) 'Date
Case 61
M03.Cells(1, 1) = Data.Cells(N, 4) 'Shift
Case 62
M03.Cells(5, 1) = Data.Cells(N, 14) 'Job(1)
Case 63
M03.Cells(5, 2) = Data.Cells(N, 15) 'Lot
Case 64
M03.Cells(5, 3) = Data.Cells(N, 16) 'Op
Case 65
M03.Cells(5, 4) = Data.Cells(N, 17) 'MPP
Case 66
M03.Cells(5, 5) = Data.Cells(N, 18) 'W.O. Qty
Case 67
M03.Cells(5, 13) = Data.Cells(N, 25) '#Pcs-Time(1)
Case 68
M03.Cells(5, 18) = Data.Cells(N, 29) '#Pcs-Time(2)
Case 69
M03.Cells(5, 23) = Data.Cells(N, 33) '#Pcs-Time(3)
Case 70
M03.Cells(5, 28) = Data.Cells(N, 37) '#Pcs-Time(4)
Case 71
M03.Cells(9, 1) = Data.Cells(N, 19) 'Job(2)
Case 72
M03.Cells(9, 2) = Data.Cells(N, 20) 'Lot
Case 73
M03.Cells(9, 3) = Data.Cells(N, 21) 'Op
Case 74
M03.Cells(9, 4) = Data.Cells(N, 22) 'MPP
Case 75
M03.Cells(9, 5) = Data.Cells(N, 23) 'W.O. Qty
Case 76
M03.Cells(9, 13) = Data.Cells(N, 26) '#Pcs-Time(1)
Case 77
M03.Cells(9, 18) = Data.Cells(N, 30) '#Pcs-Time(2)
Case 78
M03.Cells(9, 23) = Data.Cells(N, 34) '#Pcs-Time(3)
Case 79
M03.Cells(9, 28) = Data.Cells(N, 38) '#Pcs-Time(4)
Case 80
M03.Cells(13, 13) = Data.Cells(N, 27) '#Pcs-Time(1)
Case 81
M03.Cells(13, 18) = Data.Cells(N, 31) '#Pcs-Time(2)
Case 82
M03.Cells(13, 23) = Data.Cells(N, 35) '#Pcs-Time(3)
Case 83
M03.Cells(13, 28) = Data.Cells(N, 39) '#Pcs-Time(4)
Case 84
M03.Cells(17, 1) = Data.Cells(N, 49) 'Job(1)
Case 85
M03.Cells(17, 2) = Data.Cells(N, 50) 'Lot
Case 86
M03.Cells(17, 3) = Data.Cells(N, 51) 'Op
Case 87
M03.Cells(17, 4) = Data.Cells(N, 52) 'MPP
Case 88
M03.Cells(17, 5) = Data.Cells(N, 53) 'W.O. Qty
Case 89
M03.Cells(17, 13) = Data.Cells(N, 60) '#Pcs-Time(1)
Case 90
M03.Cells(17, 18) = Data.Cells(N, 64) '#Pcs-Time(2)
Case 91
M03.Cells(17, 23) = Data.Cells(N, 68) '#Pcs-Time(3)
Case 92
M03.Cells(17, 28) = Data.Cells(N, 72) '#Pcs-Time(4)
Case 93
M03.Cells(21, 1) = Data.Cells(N, 54) 'Job(2)
Case 94
M03.Cells(22, 2) = Data.Cells(N, 55) 'Lot
Case 95
M03.Cells(23, 3) = Data.Cells(N, 56) 'Op
Case 96
M03.Cells(24, 4) = Data.Cells(N, 57) 'MPP
Case 97
M03.Cells(25, 5) = Data.Cells(N, 58) 'W.O. Qty
Case 98
M03.Cells(21, 13) = Data.Cells(N, 61) '#Pcs-Time(1)
Case 99
M03.Cells(21, 18) = Data.Cells(N, 65) '#Pcs-Time(2)
Case 100
M03.Cells(21, 23) = Data.Cells(N, 69) '#Pcs-Time(3)
Case 101
M03.Cells(21, 28) = Data.Cells(N, 73) '#Pcs-Time(4)
Case 102
M03.Cells(25, 13) = Data.Cells(N, 62) '#Pcs-Time(1)
Case 103
M03.Cells(25, 18) = Data.Cells(N, 66) '#Pcs-Time(2)
Case 104
M03.Cells(25, 23) = Data.Cells(N, 70) '#Pcs-Time(3)
Case 105
M03.Cells(25, 28) = Data.Cells(N, 74) '#Pcs-Time(4)
Case 106
M03.Cells(29, 1) = Data.Cells(N, 84) 'Job(1)
Case 107
M03.Cells(29, 2) = Data.Cells(N, 85) 'Lot
Case 108
M03.Cells(29, 3) = Data.Cells(N, 86) 'Op
Case 109
M03.Cells(29, 4) = Data.Cells(N, 87) 'MPP
Case 110
M03.Cells(29, 5) = Data.Cells(N, 88) 'W.O. Qty
Case 111
M03.Cells(29, 13) = Data.Cells(N, 95) '#Pcs-Time(1)
Case 112
M03.Cells(29, 18) = Data.Cells(N, 99) '#Pcs-Time(2)
Case 113
M03.Cells(29, 23) = Data.Cells(N, 103) '#Pcs-Time(3)
Case 114
M03.Cells(29, 28) = Data.Cells(N, 107) '#Pcs-Time(4)
Case 115
M03.Cells(33, 1) = Data.Cells(N, 89) 'Job(2)
Case 116
M03.Cells(33, 2) = Data.Cells(N, 90) 'Lot
Case 117
M03.Cells(33, 3) = Data.Cells(N, 91) 'Op
Case 118
M03.Cells(33, 4) = Data.Cells(N, 92) 'MPP
Case 119
M03.Cells(33, 5) = Data.Cells(N, 93) 'W.O. Qty
Case 120
M03.Cells(33, 13) = Data.Cells(N, 96) '#Pcs-Time(1)
Case 121
M03.Cells(33, 18) = Data.Cells(N, 100) '#Pcs-Time(2)
Case 122
M03.Cells(33, 23) = Data.Cells(N, 104) '#Pcs-Time(3)
Case 123
M03.Cells(33, 28) = Data.Cells(N, 108) '#Pcs-Time(4)
Case 124
M03.Cells(37, 13) = Data.Cells(N, 97) '#Pcs-Time(1)
Case 125
M03.Cells(37, 18) = Data.Cells(N, 101) '#Pcs-Time(2)
Case 126
M03.Cells(37, 23) = Data.Cells(N, 105) '#Pcs-Time(3)
Case 127
M03.Cells(37, 28) = Data.Cells(N, 109) '#Pcs-Time(4)
Case 128
M03.Cells(41, 1) = Data.Cells(N, 119) 'Job(1)
Case 129
M03.Cells(41, 2) = Data.Cells(N, 120) 'Lot
Case 130
M03.Cells(41, 3) = Data.Cells(N, 121) 'Op
Case 131
M03.Cells(41, 4) = Data.Cells(N, 122) 'MPP
Case 132
M03.Cells(41, 5) = Data.Cells(N, 123) 'W.O. Qty
Case 133
M03.Cells(41, 13) = Data.Cells(N, 130) '#Pcs-Time(1)
Case 134
M03.Cells(41, 18) = Data.Cells(N, 134) '#Pcs-Time(2)
Case 135
M03.Cells(41, 23) = Data.Cells(N, 138) '#Pcs-Time(3)
Case 136
M03.Cells(41, 28) = Data.Cells(N, 142) '#Pcs-Time(4)
Case 137
M03.Cells(45, 1) = Data.Cells(N, 124) 'Job(2)
Case 138
M03.Cells(45, 2) = Data.Cells(N, 125) 'Lot
Case 139
M03.Cells(45, 3) = Data.Cells(N, 126) 'Op
Case 140
M03.Cells(45, 4) = Data.Cells(N, 127) 'MPP
Case 141
M03.Cells(45, 5) = Data.Cells(N, 128) 'W.O. Qty
Case 142
M03.Cells(45, 13) = Data.Cells(N, 131) '#Pcs-Time(1)
Case 143
M03.Cells(45, 18) = Data.Cells(N, 135) '#Pcs-Time(2)
Case 144
M03.Cells(45, 23) = Data.Cells(N, 139) '#Pcs-Time(3)
Case 145
M03.Cells(45, 28) = Data.Cells(N, 143) '#Pcs-Time(4)
Case 146
M03.Cells(49, 13) = Data.Cells(N, 132) '#Pcs-Time(1)
Case 147
M03.Cells(49, 18) = Data.Cells(N, 136) '#Pcs-Time(2)
Case 148
M03.Cells(49, 23) = Data.Cells(N, 140) '#Pcs-Time(3)
Case 149
M03.Cells(49, 28) = Data.Cells(N, 144) '#Pcs-Time(4)

End Select
Next X


M03Map.Activate
M03.Activate
Data.Activate

End Sub


Hi all,
I am running the following on worksheets to sum the information from above. I was wondering if there was any way you could think of to simplify...As you can see, I am not running it on every row & sometimes I need to pull information from either Column A or Column B, so I doubt it can be simplified...But I figured I would check with you all.

Also, how would bring the formating down with the code? As of right now I have to run the code, format paint over top of the new section at the bottom, and then copy and past the row headings from Columns 1 through 4.

Any help would be appreciated:


Sub SumsSheets()
Dim ws As Worksheet, LR As Long, i As Integer
For Each ws In ThisWorkbook.Worksheets
With ws
LR = .Cells.Find("*", searchdirection:=xlPrevious, searchorder:=xlByRows).Row
For i = 5 To 17
.Cells(LR + 8, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B10)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 9, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B11)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 10, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B12)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 11, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B13)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 12, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B14)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 13, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B15)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 14, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B16)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 16, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B18)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 20, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B22)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 21, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B23)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 22, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B24)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 23, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B25)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 24, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B26)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 25, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B27)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 26, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B28)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 27, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B29)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 28, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B30)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 29, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B31)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 30, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B32)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 31, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B33)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 32, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B34)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 33, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B35)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 34, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B36)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 35, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B37)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 36, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B38)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 37, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B39)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 38, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B40)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 39, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B41)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 40, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B42)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 41, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B43)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 42, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B44)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 44, i).Formula = "=SUMPRODUCT(--($A$1:$A$" & LR & "=$A46)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 47, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B49)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 48, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B50)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 49, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B51)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 50, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B52)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 51, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B53)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 53, i).Formula = "=SUMPRODUCT(--($B$1:$B$" & LR & "=$B55)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
.Cells(LR + 55, i).Formula = "=SUMPRODUCT(--($A$1:$A$" & LR & "=$A57)," & .Range(.Cells(1, i), .Cells(LR, i)).Address & ")"
Next i
End With
Next ws
End Sub


hi, i'm using a workbook function to pre populate some cells on a sheet with numeric figures

using:
Code:

Private Sub worksheet_activate()
Application.ScreenUpdating = False
If Cells(9, 2) = "" Then
Cells(9, 2) = 0
Cells(10, 2) = 5
Cells(11, 2) = 50
Cells(12, 2) = 40
Cells(13, 2) = 4
Cells(14, 2) = 3
Cells(15, 2) = 5
Cells(16, 2) = 10
Cells(17, 2) = 3
Cells(18, 2) = 5
Cells(19, 2) = 0
Cells(20, 2) = 5
Cells(21, 2) = 10
Cells(22, 2) = 20
Cells(23, 2) = 10
Cells(24, 2) = 20
Cells(25, 2) = 0
Cells(26, 2) = 5
Cells(27, 2) = 5
Cells(28, 2) = 10
Cells(29, 2) = "Cells above have been pre-populated with default figures"
Exit Sub
Else
Exit Sub
End If
End Sub


but it takes ages to run as it does each cell one at a time.

is there a function in excel to drop all these figures into the cells in one go (or just speed this function up?)


I have created a workbook which contains (2) spreadsheets:

1) Sheet1 (IRR)- is used to input data that applies to particular movies that our inventory manager wants to purchase for restocking purposes

2) Sheet2 (Form)- a macro has been written to pull the data from Sheet1 and insert it into the appropriate cell in the form which I have created on Sheet2.

Refer to the code below to help me with the following:

Q: Can I add lines of code within this macro to: Sort the data within the form in ascending order (recall data is pulled from a single row in Sheet1) Make every other line in the form gray for easy reading If you have any further questions, I'd be happy to send the spreadsheet for you to view. Please send me a private message with your email.


Sub QuickFlicks()
'
' Keyboard Shortcut: Ctrl+r
' Dim X As Integer
Dim N As Integer

Dim IRR As Worksheet
Dim FORM As Worksheet

Set IRR = Worksheets("IRR")
Set FORM = Worksheets("FORM")

IRR.Activate

N = ActiveCell.Row

For X = 1 To 245
Select Case X
Case 1
FORM.Cells(2, 15) = IRR.Cells(N, 1) 'IRR#
Case 2
FORM.Cells(2, 16) = IRR.Cells(N, 2) 'IRR#
Case 3
FORM.Cells(3, 7) = IRR.Cells(N, 3) 'DATE
Case 4
FORM.Cells(38, 2) = IRR.Cells(N, 4) 'REQ. BY.
Case 5
FORM.Cells(6, 1) = IRR.Cells(N, 6) 'Movie Title
Case 6
FORM.Cells(6, 2) = IRR.Cells(N, 7) 'Release Dt.
Case 7
FORM.Cells(6, 3) = IRR.Cells(N, 8) 'Genre
Case 8
FORM.Cells(6, 4) = IRR.Cells(N, 9) 'Box Office Revenue (Domestic)
Case 9
FORM.Cells(6, 5) = IRR.Cells(N, 10) '# Copies
Case 10
FORM.Cells(6, 6) = IRR.Cells(N, 11) 'Type of Release
Case 11
FORM.Cells(6, 7) = IRR.Cells(N, 12) 'Studio
Case 12
FORM.Cells(7, 1) = IRR.Cells(N, 14) 'Movie Title
Case 13
FORM.Cells(7, 2) = IRR.Cells(N, 15) 'Release Dt.
Case 14
FORM.Cells(7, 3) = IRR.Cells(N, 16) 'Genre
Case 15
FORM.Cells(7, 4) = IRR.Cells(N, 17) 'Box Office Revenue (Domestic)
Case 16
FORM.Cells(7, 5) = IRR.Cells(N, 18) '# Copies
Case 17
FORM.Cells(7, 6) = IRR.Cells(N, 19) 'Type of Release
Case 18
FORM.Cells(7, 7) = IRR.Cells(N, 20) 'Studio
Case 19
FORM.Cells(8, 1) = IRR.Cells(N, 22) 'Movie Title
Case 20
FORM.Cells(8, 2) = IRR.Cells(N, 23) 'Release Dt.
Case 21
FORM.Cells(8, 3) = IRR.Cells(N, 24) 'Genre
Case 22
FORM.Cells(8, 4) = IRR.Cells(N, 25) 'Box Office Revenue (Domestic)
Case 23
FORM.Cells(8, 5) = IRR.Cells(N, 26) '# Copies
Case 24
FORM.Cells(8, 6) = IRR.Cells(N, 27) 'Type of Release
Case 25
FORM.Cells(8, 7) = IRR.Cells(N, 28) 'Studio
Case 26
FORM.Cells(9, 1) = IRR.Cells(N, 30) 'Movie Title
Case 27
FORM.Cells(9, 2) = IRR.Cells(N, 31) 'Release Dt.
Case 28
FORM.Cells(9, 3) = IRR.Cells(N, 32) 'Genre
Case 29
FORM.Cells(9, 4) = IRR.Cells(N, 33) 'Box Office Revenue (Domestic)
Case 30
FORM.Cells(9, 5) = IRR.Cells(N, 34) '# Copies
Case 31
FORM.Cells(9, 6) = IRR.Cells(N, 35) 'Type of Release
Case 32
FORM.Cells(9, 7) = IRR.Cells(N, 36) 'Studio
Case 33
FORM.Cells(10, 1) = IRR.Cells(N, 38) 'Movie Title
Case 34
FORM.Cells(10, 2) = IRR.Cells(N, 39) 'Release Dt.
Case 35
FORM.Cells(10, 3) = IRR.Cells(N, 40) 'Genre
Case 36
FORM.Cells(10, 4) = IRR.Cells(N, 41) 'Box Office Revenue (Domestic)
Case 37
FORM.Cells(10, 5) = IRR.Cells(N, 42) '# Copies
Case 38
FORM.Cells(10, 6) = IRR.Cells(N, 43) 'Type of Release
Case 39
FORM.Cells(10, 7) = IRR.Cells(N, 44) 'Studio
Case 40
FORM.Cells(11, 1) = IRR.Cells(N, 46) 'Movie Title
Case 41
FORM.Cells(11, 2) = IRR.Cells(N, 47) 'Release Dt.
Case 42
FORM.Cells(11, 3) = IRR.Cells(N, 48) 'Genre
Case 43
FORM.Cells(11, 4) = IRR.Cells(N, 49) 'Box Office Revenue (Domestic)
Case 44
FORM.Cells(11, 5) = IRR.Cells(N, 50) '# Copies
Case 45
FORM.Cells(11, 6) = IRR.Cells(N, 51) 'Type of Release
Case 46
FORM.Cells(11, 7) = IRR.Cells(N, 52) 'Studio
Case 47
FORM.Cells(12, 1) = IRR.Cells(N, 54) 'Movie Title
Case 48
FORM.Cells(12, 2) = IRR.Cells(N, 55) 'Release Dt.
Case 49
FORM.Cells(12, 3) = IRR.Cells(N, 56) 'Genre
Case 50
FORM.Cells(12, 4) = IRR.Cells(N, 57) 'Box Office Revenue (Domestic)
Case 51
FORM.Cells(12, 5) = IRR.Cells(N, 58) '# Copies
Case 52
FORM.Cells(12, 6) = IRR.Cells(N, 59) 'Type of Release
Case 53
FORM.Cells(12, 7) = IRR.Cells(N, 60) 'Studio
Case 54
FORM.Cells(13, 1) = IRR.Cells(N, 62) 'Movie Title
Case 55
FORM.Cells(13, 2) = IRR.Cells(N, 63) 'Release Dt.
Case 56
FORM.Cells(13, 3) = IRR.Cells(N, 64) 'Genre
Case 57
FORM.Cells(13, 4) = IRR.Cells(N, 65) 'Box Office Revenue (Domestic)
Case 58
FORM.Cells(13, 5) = IRR.Cells(N, 66) '# Copies
Case 59
FORM.Cells(13, 6) = IRR.Cells(N, 67) 'Type of Release
Case 60
FORM.Cells(13, 7) = IRR.Cells(N, 68) 'Studio
Case 61
FORM.Cells(14, 1) = IRR.Cells(N, 70) 'Movie Title
Case 62
FORM.Cells(14, 2) = IRR.Cells(N, 71) 'Release Dt.
Case 63
FORM.Cells(14, 3) = IRR.Cells(N, 72) 'Genre
Case 64
FORM.Cells(14, 4) = IRR.Cells(N, 73) 'Box Office Revenue (Domestic)
Case 65
FORM.Cells(14, 5) = IRR.Cells(N, 74) '# Copies
Case 66
FORM.Cells(14, 6) = IRR.Cells(N, 75) 'Type of Release
Case 67
FORM.Cells(14, 7) = IRR.Cells(N, 76) 'Studio
Case 68
FORM.Cells(15, 1) = IRR.Cells(N, 78) 'Movie Title
Case 69
FORM.Cells(15, 2) = IRR.Cells(N, 79) 'Release Dt.
Case 70
FORM.Cells(15, 3) = IRR.Cells(N, 80) 'Genre
Case 71
FORM.Cells(15, 4) = IRR.Cells(N, 81) 'Box Office Revenue (Domestic)
Case 72
FORM.Cells(15, 5) = IRR.Cells(N, 82) '# Copies
Case 73
FORM.Cells(15, 6) = IRR.Cells(N, 83) 'Type of Release
Case 74
FORM.Cells(15, 7) = IRR.Cells(N, 84) 'Studio
Case 75
FORM.Cells(16, 1) = IRR.Cells(N, 86) 'Movie Title
Case 76
FORM.Cells(16, 2) = IRR.Cells(N, 87) 'Release Dt.
Case 77
FORM.Cells(16, 3) = IRR.Cells(N, 88) 'Genre
Case 78
FORM.Cells(16, 4) = IRR.Cells(N, 89) 'Box Office Revenue (Domestic)
Case 79
FORM.Cells(16, 5) = IRR.Cells(N, 90) '# Copies
Case 80
FORM.Cells(16, 6) = IRR.Cells(N, 91) 'Type of Release
Case 81
FORM.Cells(16, 7) = IRR.Cells(N, 92) 'Studio
Case 82
FORM.Cells(17, 1) = IRR.Cells(N, 94) 'Movie Title
Case 83
FORM.Cells(17, 2) = IRR.Cells(N, 95) 'Release Dt.
Case 84
FORM.Cells(17, 3) = IRR.Cells(N, 96) 'Genre
Case 85
FORM.Cells(17, 4) = IRR.Cells(N, 97) 'Box Office Revenue (Domestic)
Case 86
FORM.Cells(17, 5) = IRR.Cells(N, 98) '# Copies
Case 87
FORM.Cells(17, 6) = IRR.Cells(N, 99) 'Type of Release
Case 88
FORM.Cells(17, 7) = IRR.Cells(N, 100) 'Studio
Case 89
FORM.Cells(18, 1) = IRR.Cells(N, 102) 'Movie Title
Case 90
FORM.Cells(18, 2) = IRR.Cells(N, 103) 'Release Dt.
Case 91
FORM.Cells(18, 3) = IRR.Cells(N, 104) 'Genre
Case 92
FORM.Cells(18, 4) = IRR.Cells(N, 105) 'Box Office Revenue (Domestic)
Case 93
FORM.Cells(18, 5) = IRR.Cells(N, 106) '# Copies
Case 94
FORM.Cells(18, 6) = IRR.Cells(N, 107) 'Type of Release
Case 95
FORM.Cells(18, 7) = IRR.Cells(N, 108) 'Studio
Case 96
FORM.Cells(19, 1) = IRR.Cells(N, 110) 'Movie Title
Case 97
FORM.Cells(19, 2) = IRR.Cells(N, 111) 'Release Dt.
Case 98
FORM.Cells(19, 3) = IRR.Cells(N, 112) 'Genre
Case 99
FORM.Cells(19, 4) = IRR.Cells(N, 113) 'Box Office Revenue (Domestic)
Case 100
FORM.Cells(19, 5) = IRR.Cells(N, 114) '# Copies
Case 101
FORM.Cells(19, 6) = IRR.Cells(N, 115) 'Type of Release
Case 102
FORM.Cells(19, 7) = IRR.Cells(N, 116) 'Studio
Case 103
FORM.Cells(20, 1) = IRR.Cells(N, 118) 'Movie Title
Case 104
FORM.Cells(20, 2) = IRR.Cells(N, 119) 'Release Dt.
Case 105
FORM.Cells(20, 3) = IRR.Cells(N, 120) 'Genre
Case 106
FORM.Cells(20, 4) = IRR.Cells(N, 121) 'Box Office Revenue (Domestic)
Case 107
FORM.Cells(20, 5) = IRR.Cells(N, 122) '# Copies
Case 108
FORM.Cells(20, 6) = IRR.Cells(N, 123) 'Type of Release
Case 109
FORM.Cells(20, 7) = IRR.Cells(N, 124) 'Studio
Case 110
FORM.Cells(21, 1) = IRR.Cells(N, 126) 'Movie Title
Case 111
FORM.Cells(21, 2) = IRR.Cells(N, 127) 'Release Dt.
Case 112
FORM.Cells(21, 3) = IRR.Cells(N, 128) 'Genre
Case 113
FORM.Cells(21, 4) = IRR.Cells(N, 129) 'Box Office Revenue (Domestic)
Case 114
FORM.Cells(21, 5) = IRR.Cells(N, 130) '# Copies
Case 115
FORM.Cells(21, 6) = IRR.Cells(N, 131) 'Type of Release
Case 116
FORM.Cells(21, 7) = IRR.Cells(N, 132) 'Studio
Case 117
FORM.Cells(22, 1) = IRR.Cells(N, 134) 'Movie Title
Case 118
FORM.Cells(22, 2) = IRR.Cells(N, 135) 'Release Dt.
Case 119
FORM.Cells(22, 3) = IRR.Cells(N, 136) 'Genre
Case 120
FORM.Cells(22, 4) = IRR.Cells(N, 137) 'Box Office Revenue (Domestic)
Case 121
FORM.Cells(22, 5) = IRR.Cells(N, 138) '# Copies
Case 122
FORM.Cells(22, 6) = IRR.Cells(N, 139) 'Type of Release
Case 123
FORM.Cells(22, 7) = IRR.Cells(N, 140) 'Studio
Case 124
FORM.Cells(23, 1) = IRR.Cells(N, 142) 'Movie Title
Case 125
FORM.Cells(23, 2) = IRR.Cells(N, 143) 'Release Dt.
Case 126
FORM.Cells(23, 3) = IRR.Cells(N, 144) 'Genre
Case 127
FORM.Cells(23, 4) = IRR.Cells(N, 145) 'Box Office Revenue (Domestic)
Case 128
FORM.Cells(23, 5) = IRR.Cells(N, 146) '# Copies
Case 129
FORM.Cells(23, 6) = IRR.Cells(N, 147) 'Type of Release
Case 130
FORM.Cells(23, 7) = IRR.Cells(N, 148) 'Studio
Case 131
FORM.Cells(24, 1) = IRR.Cells(N, 150) 'Movie Title
Case 132
FORM.Cells(24, 2) = IRR.Cells(N, 151) 'Release Dt.
Case 133
FORM.Cells(24, 3) = IRR.Cells(N, 152) 'Genre
Case 134
FORM.Cells(24, 4) = IRR.Cells(N, 153) 'Box Office Revenue (Domestic)
Case 135
FORM.Cells(24, 5) = IRR.Cells(N, 154) '# Copies
Case 136
FORM.Cells(24, 6) = IRR.Cells(N, 155) 'Type of Release
Case 137
FORM.Cells(24, 7) = IRR.Cells(N, 156) 'Studio
Case 138
FORM.Cells(25, 1) = IRR.Cells(N, 158) 'Movie Title
Case 139
FORM.Cells(25, 2) = IRR.Cells(N, 159) 'Release Dt.
Case 140
FORM.Cells(25, 3) = IRR.Cells(N, 160) 'Genre
Case 141
FORM.Cells(25, 4) = IRR.Cells(N, 161) 'Box Office Revenue (Domestic)
Case 142
FORM.Cells(25, 5) = IRR.Cells(N, 162) '# Copies
Case 143
FORM.Cells(25, 6) = IRR.Cells(N, 163) 'Type of Release
Case 144
FORM.Cells(25, 7) = IRR.Cells(N, 164) 'Studio
Case 145
FORM.Cells(26, 1) = IRR.Cells(N, 166) 'Movie Title
Case 146
FORM.Cells(26, 2) = IRR.Cells(N, 167) 'Release Dt.
Case 147
FORM.Cells(26, 3) = IRR.Cells(N, 168) 'Genre
Case 148
FORM.Cells(26, 4) = IRR.Cells(N, 169) 'Box Office Revenue (Domestic)
Case 149
FORM.Cells(26, 5) = IRR.Cells(N, 170) '# Copies
Case 150
FORM.Cells(26, 6) = IRR.Cells(N, 171) 'Type of Release
Case 151
FORM.Cells(26, 7) = IRR.Cells(N, 172) 'Studio
Case 152
FORM.Cells(27, 1) = IRR.Cells(N, 174) 'Movie Title
Case 153
FORM.Cells(27, 2) = IRR.Cells(N, 175) 'Release Dt.
Case 154
FORM.Cells(27, 3) = IRR.Cells(N, 176) 'Genre
Case 155
FORM.Cells(27, 4) = IRR.Cells(N, 177) 'Box Office Revenue (Domestic)
Case 156
FORM.Cells(27, 5) = IRR.Cells(N, 178) '# Copies
Case 157
FORM.Cells(27, 6) = IRR.Cells(N, 179) 'Type of Release
Case 158
FORM.Cells(27, 7) = IRR.Cells(N, 180) 'Studio
Case 159
FORM.Cells(28, 1) = IRR.Cells(N, 182) 'Movie Title
Case 160
FORM.Cells(28, 2) = IRR.Cells(N, 183) 'Release Dt.
Case 161
FORM.Cells(28, 3) = IRR.Cells(N, 184) 'Genre
Case 162
FORM.Cells(28, 4) = IRR.Cells(N, 185) 'Box Office Revenue (Domestic)
Case 163
FORM.Cells(28, 5) = IRR.Cells(N, 186) '# Copies
Case 164
FORM.Cells(28, 6) = IRR.Cells(N, 187) 'Type of Release
Case 165
FORM.Cells(28, 7) = IRR.Cells(N, 188) 'Studio
Case 166
FORM.Cells(29, 1) = IRR.Cells(N, 190) 'Movie Title
Case 167
FORM.Cells(29, 2) = IRR.Cells(N, 191) 'Release Dt.
Case 168
FORM.Cells(29, 3) = IRR.Cells(N, 192) 'Genre
Case 169
FORM.Cells(29, 4) = IRR.Cells(N, 193) 'Box Office Revenue (Domestic)
Case 170
FORM.Cells(29, 5) = IRR.Cells(N, 194) '# Copies
Case 171
FORM.Cells(29, 6) = IRR.Cells(N, 195) 'Type of Release
Case 172
FORM.Cells(29, 7) = IRR.Cells(N, 196) 'Studio
Case 173
FORM.Cells(30, 1) = IRR.Cells(N, 198) 'Movie Title
Case 174
FORM.Cells(30, 2) = IRR.Cells(N, 199) 'Release Dt.
Case 175
FORM.Cells(30, 3) = IRR.Cells(N, 200) 'Genre
Case 176
FORM.Cells(30, 4) = IRR.Cells(N, 201) 'Box Office Revenue (Domestic)
Case 177
FORM.Cells(30, 5) = IRR.Cells(N, 202) '# Copies
Case 178
FORM.Cells(30, 6) = IRR.Cells(N, 203) 'Type of Release
Case 179
FORM.Cells(30, 7) = IRR.Cells(N, 204) 'Studio
Case 180
FORM.Cells(31, 1) = IRR.Cells(N, 206) 'Movie Title
Case 181
FORM.Cells(31, 2) = IRR.Cells(N, 207) 'Release Dt.
Case 182
FORM.Cells(31, 3) = IRR.Cells(N, 208) 'Genre
Case 183
FORM.Cells(31, 4) = IRR.Cells(N, 209) 'Box Office Revenue (Domestic)
Case 184
FORM.Cells(31, 5) = IRR.Cells(N, 210) '# Copies
Case 185
FORM.Cells(31, 6) = IRR.Cells(N, 211) 'Type of Release
Case 186
FORM.Cells(31, 7) = IRR.Cells(N, 212) 'Studio
Case 187
FORM.Cells(32, 1) = IRR.Cells(N, 214) 'Movie Title
Case 188
FORM.Cells(32, 2) = IRR.Cells(N, 215) 'Release Dt.
Case 189
FORM.Cells(32, 3) = IRR.Cells(N, 216) 'Genre
Case 190
FORM.Cells(32, 4) = IRR.Cells(N, 217) 'Box Office Revenue (Domestic)
Case 191
FORM.Cells(32, 5) = IRR.Cells(N, 218) '# Copies
Case 192
FORM.Cells(32, 6) = IRR.Cells(N, 219) 'Type of Release
Case 193
FORM.Cells(32, 7) = IRR.Cells(N, 220) 'Studio
Case 194
FORM.Cells(33, 1) = IRR.Cells(N, 222) 'Movie Title
Case 195
FORM.Cells(33, 2) = IRR.Cells(N, 223) 'Release Dt.
Case 196
FORM.Cells(33, 3) = IRR.Cells(N, 224) 'Genre
Case 197
FORM.Cells(33, 4) = IRR.Cells(N, 225) 'Box Office Revenue (Domestic)
Case 198
FORM.Cells(33, 5) = IRR.Cells(N, 226) '# Copies
Case 199
FORM.Cells(33, 6) = IRR.Cells(N, 227) 'Type of Release
Case 200
FORM.Cells(33, 7) = IRR.Cells(N, 228) 'Studio
Case 201
FORM.Cells(34, 1) = IRR.Cells(N, 230) 'Movie Title
Case 202
FORM.Cells(34, 2) = IRR.Cells(N, 231) 'Release Dt.
Case 203
FORM.Cells(34, 3) = IRR.Cells(N, 232) 'Genre
Case 204
FORM.Cells(34, 4) = IRR.Cells(N, 233) 'Box Office Revenue (Domestic)
Case 205
FORM.Cells(34, 5) = IRR.Cells(N, 234) '# Copies
Case 206
FORM.Cells(34, 6) = IRR.Cells(N, 235) 'Type of Release
Case 207
FORM.Cells(34, 7) = IRR.Cells(N, 236) 'Studio
Case 208
FORM.Cells(35, 1) = IRR.Cells(N, 238) 'Movie Title
Case 209
FORM.Cells(35, 2) = IRR.Cells(N, 239) 'Release Dt.
Case 210
FORM.Cells(35, 3) = IRR.Cells(N, 240) 'Genre
Case 211
FORM.Cells(35, 4) = IRR.Cells(N, 241) 'Box Office Revenue (Domestic)
Case 212
FORM.Cells(35, 5) = IRR.Cells(N, 242) '# Copies
Case 213
FORM.Cells(35, 6) = IRR.Cells(N, 243) 'Type of Release
Case 214
FORM.Cells(35, 7) = IRR.Cells(N, 244) 'Studio
Case 215
FORM.Cells(3, 5) = IRR.Cells(N, 245) 'Total # Copies

End Select
Next X

FORM.Activate
FORM.PrintOut
IRR.Activate


End Sub


I have a small macro that loops through and concatenates 4 different values into a single cell on worksheet. Some of the values could either be "Pass" or "Fail" as input into another part of the workbook. I would like the concatenation to have the "Pass" value to be green and the "Fail" value to be red within the concatenation. Below is the code
Code:

Sub BuildDocPackageLists()
Dim I As Integer
Dim R As Integer
Dim B As Integer
Dim C As Integer
B = 1
C = 17
 
Sheet6.Range("Q2:Y50").ClearContents
    Do Until B = 10
        Sheet6.Cells(26, 2).Value = Sheet6.Cells(B, 6)
            R = 2
            I = 2
            Do Until IsEmpty(Sheet5.Cells(I, 6))
                If Sheet5.Cells(I, 7).Value = "Yes" Then
                    Sheet6.Cells(R, C).Value = Sheet5.Cells(I, 1).Value _
                         & " - " & Sheet5.Cells(I, 2).Value & " - " & _
                         Sheet4.Cells(I, 3) & " - " & Sheet4.Cells(I, 6)
                    R = R + 1
                End If
                I = I + 1
            Loop
        C = C + 1
        B = B + 1
    Loop
Sheet6.Cells(26, 2).Value = Sheet6.Cells(1, 6)
 
    Application.ActivePrinter = "Adobe PDF on Ne03:"
    ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,""Adobe PDF on Ne03:"",,TRUE,,FALSE)"
End Sub


The values that are brought over from Sheet4 are the ones that would need to be colored. (Sheet4.Cells(I, 3) & " - " & Sheet4.Cells(I, 6)). Is there an easy way to acomplish this? The cells in Sheet 4 are already conditionally formated to color the font red and green if that helps.

Thanks!


Hi,
I have a problem with a formatting issue, the raw data appears like (A) and I need it to look Like (B).

(A)
a1 Order Date |B1 Store number|C1 Store Name|D1 Contact Name|E1 Type of Stand|F1 Size of Stand|G1 code of order 1|H1 Code Description of order 1|I1 Quantity of order 1|J1 code of order 2|K1 Code Description of order 2|L1 Quantity of order 2| etc through to AJ.

(B)
a1-A10 Order Date|B1-B10 Store number|C1-C10 Store Name|D1-D10 Contact Name|E1-E10 Type of Stand |F1-F10 Size of Stand|G1-G10 Code of order|H1-H10 description of order|I1-I10 quantity of order.

A gentleman called Andrew Poulmson helped last time but the order in which the data is send has now changed.


Sub Test()
Dim Sh As Worksheet
Dim Rng As Range
Dim ShNew As Worksheet
Dim x As Integer
Dim r As Integer
Dim c As Integer
Set Sh = Worksheets("Sheet1")
Set Rng = Sh.Range("A1").CurrentRegion
Set ShNew = Worksheets.Add
x = 1
With ShNew
.Cells(x, 1) = Sh.Cells(x, 1)
.Cells(x, 2) = Sh.Cells(x, 2)
.Cells(x, 3) = Sh.Cells(x, 3)
.Cells(x, 4) = Sh.Cells(x, 4)
.Cells(x, 5) = Sh.Cells(x, 5)
.Cells(x, 6) = "Code"
.Cells(x, 7) = "Description"
.Cells(x, 8) = "Quantity"
End With
x = x + 1
With Rng
For r = 2 To .Rows.Count
For c = 6 To .Cells(r, 6).End(xlToRight).Column Step 3
ShNew.Cells(x, 1) = Rng.Cells(r, 1)
ShNew.Cells(x, 2) = Rng.Cells(r, 2)
ShNew.Cells(x, 3) = Rng.Cells(r, 3)
ShNew.Cells(x, 4) = Rng.Cells(r, 4)
ShNew.Cells(x, 5) = Rng.Cells(r, 5)
ShNew.Cells(x, 6) = Rng.Cells(r, c)
ShNew.Cells(x, 7) = Rng.Cells(r, c + 1)
ShNew.Cells(x, 8) = Rng.Cells(r, c + 2)
x = x + 1
Next c
Next r
End With
End Sub


If someone could please help by letting me know which fields I need change to get the Marco running again I'd be very greatful.

Thanks

Grettons




I just don't seen to be able to make it work right.
When Im inputing information on any of the cells within the range given, Excel lock up, guessing is because it enters on a loop due to the worksheet event "Change". Any ideas on how to make it work properly?

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    C = Cells(Rows.Count, "A").End(xlUp).Row    'Last Cell Use
    R = Target.Row                              'Row
    If Not Intersect(Target, Range("B6:R" & C - 1)) Is Nothing Then
        Cells(R, 4).Value = Cells(R, 2).Value + Cells(R, 3).Value
        Cells(R, 6).Value = Cells(R, 5).Value - Cells(R, 4).Value
        Cells(R, 12).Value = Cells(R, 9).Value + Cells(R, 10).Value + Cells(R, 11).Value
        Cells(R, 14).Value = Cells(R, 13).Value - Cells(R, 12).Value
        Cells(R, 15).Value = Cells(R, 4).Value + Cells(R, 8).Value + Cells(R, 12).Value
        Cells(R, 17).Value = Cells(R, 16).Value - Cells(R, 15).Value
    End If
End Sub





I need help with the use of a check box and linking cells via format control. Or maybe I should use a macro???? I am creating a workbook for other users to enter data. This workbook will include 1 worksheet for each day of the month and then a worksheet for tallying some of the input. On the daily worksheets, I have several check boxes which link to the tally worksheet through the format control. I have only created days 1-7 and am wondering if there is a faster way to link the cells then redoing each one individually. I tried to copy and paste the worksheet from 1 day to the next, but it doesn't automatically update the cell link in the control format to the next row on the tally sheet. I have attached a workbook sample. I have highlighted the check boxes, and if you click on the checkbox control and then look at the cell link and follow to the tally worksheet, I think you'll see what I'm trying to do. Any help would be GREATLY APPRECIATED as I'm getting desperate.


Can someone help me understand why the macro is not copying and pasting as instructed (see bold) line. All other lines copy and past over fine, but the value from the Interns worksheet is not copying to the Form worksheet.

The shortcut is Ctrl+a...does this have something to do with it?

Sub Accounting()
' Keyboard Shortcut: Ctrl+a
' Dim X As Integer
Dim N As Integer

Dim Interns As Worksheet
Dim FeedbackForm As Worksheet

Set Interns = Worksheets("Interns")
Set FeedbackForm = Worksheets("FeedbackForm")

Interns.Activate

N = ActiveCell.Row

For X = 1 To 100
Select Case X
Case 1
FeedbackForm.Cells(6, 3) = Interns.Cells(N, 1) 'Intern
Case 2
FeedbackForm.Cells(4, 28) = Interns.Cells(N, 2) 'Department
Case 3
FeedbackForm.Cells(18, 12) = Interns.Cells(N, 11) 'Obj #6- Accounting
Case 4
FeedbackForm.Cells(20, 12) = Interns.Cells(N, 13) 'Dim #1- Team Unit/Contribution
Case 5
FeedbackForm.Cells(22, 12) = Interns.Cells(N, 14) 'Dim #2- Communication
Case 6
FeedbackForm.Cells(24, 12) = Interns.Cells(N, 15) 'Dim #3- Willing to Learn
Case 7
FeedbackForm.Cells(26, 12) = Interns.Cells(N, 16) 'Dim #4- Strong Work Ethic
Case 8
FeedbackForm.Cells(28, 12) = Interns.Cells(N, 17) 'Dim #5- Quality
Case 9
FeedbackForm.Cells(30, 12) = Interns.Cells(N, 18) 'Dim #6- Strategic Planning & Organizing
Case 10
FeedbackForm.Cells(32, 12) = Interns.Cells(N, 19) 'Dim #7- Problem Solving
Case 11
FeedbackForm.Cells(34, 12) = Interns.Cells(N, 20) 'Dim #8- Leadership & Initiative
Case 12
FeedbackForm.Cells(36, 12) = Interns.Cells(N, 21) 'Dim #9- Productivity
Case 13
FeedbackForm.Cells(38, 12) = Interns.Cells(N, 22) 'Dim #10- Customer Orientation
Case 14
FeedbackForm.Cells(40, 12) = Interns.Cells(N, 33) 'Total Score
Case 15
FeedbackForm.Cells(44, 1) = Interns.Cells(N, 51) 'Comment #1
Case 16
FeedbackForm.Cells(46, 1) = Interns.Cells(N, 52) 'Comment #2
Case 17
FeedbackForm.Cells(48, 1) = Interns.Cells(N, 53) 'Comment #3
Case 18
FeedbackForm.Cells(50, 1) = Interns.Cells(N, 54) 'Comment #4

End Select
Next X


FeedbackForm.Activate
Interns.Activate

End Sub


Hi
I need to build a macro that will do the following:
1.For every unique value in columnA generate a new worksheet.
2. Name of the new worksheet should be equal to the unique value.
3. Write "" in known cells in the new worksheet. (certain cells will need to formatted - such as borders etc) but the cell to manipulate will always remain same.
4. Copy values from other cells (or columns) in the same row (as that of the unique value) into known cells on the new worksheet created.
5. Move on to the next unique value and repeat.

Any idea how this can be done in excel 2007?


I am trying to enter an IF statement in Excel VBA. I want to look at column A and if the formula result for Left is P then to do a string of multipication. VBA keeps giving me a runtime 24 error. My code is posted below. Thank you in advance for your help.

Sheets("CODE").Select
For I = 1 To 1000
If Left(Cells(I, 1), 1).Value = "P" Then
Cells(I, 38) = (Cells(I, 2) * Cells(I, 14))
Cells(I, 39) = (Cells(I, 3) * Cells(I, 15))
Cells(I, 40) = (Cells(I, 4) * Cells(I, 16))
Cells(I, 41) = (Cells(I, 5) * Cells(I, 17))
Cells(I, 42) = (Cells(I, 6) * Cells(I, 18))
Cells(I, 43) = (Cells(I, 7) * Cells(I, 19))
Cells(I, 44) = (Cells(I, 8) * Cells(I, 20))
Cells(I, 45) = (Cells(I, 9) * Cells(I, 21))
Cells(I, 46) = (Cells(I, 10) * Cells(I, 22))
Cells(I, 47) = (Cells(I, 11) * Cells(I, 23))
Cells(I, 48) = (Cells(I, 12) * Cells(I, 24))
Cells(I, 49) = (Cells(I, 13) * Cells(I, 25))
End If
Next I


I have a large workbook that shares data between two worksheets. I need to copy specific cells from the original worksheet, based on criteria in one of the cells to different cells in the destination worksheet. The in the rows for the two worksheets are not identical, that is why I can't copy the entire row. I need to copy cells from columns B-E and H-I in the origin worksheet, to cells in columns A-F in the destination worksheet all based on the criteria in cell B of the origin worksheet. If possible, after the move I need to delete all duplicates created by the copy operation. I have just started learning VBA and this task is way beyond my current knowledge, any help you can provide is greatly appreciated.

Hi ,

I have the two files. in BOOK1.xlsone file I have data in table format with certain colums....
i want tranfer table data to check.xls file to paste in certain cells.

i created the macro, however i'm getting error meesge as Runtime error 9, Subscript out of range.
please help me out.


Quote:

Sub chekcon()
Dim check, book1 As Workbook
Dim wk1, wk2 As Worksheet
Dim i As Integer
Dim lstrw As Integer
Set book1 = ThisWorkbook
Set check = Workbooks("Z:\66205_TEMPLATES_20996\Check Control Processing Form-XX-XX-XXXX.XLS")
Set wk1 = book1.Worksheets("sheet1")
Set wk2 = check.Worksheets("sheet1")
lstrw = book1.Cells(65530, 1).End(xlUp).Row
For i = 2 To lstrw
book1.Cells(i, 1).Value = check.Cells(3, 3).Value
book1.Cells(i, 2).Value = check.Cells(11, 5).Value
book1.Cells(i, 3).Value = check.Cells(1, 4).Value
book1.Cells(i, 4).Value = check.Cells(1, 10).Value
book1.Cells(i, 5).Value = check.Cells(13, 5).Value
book1.Cells(i, 5).Value = check.Cells(3, 6).Value
book1.Cells(i, 6).Value = check.Cells(11, 10).Value
book1.Cells(i, 7).Value = check.Cells(3, 11).Value
book1.Cells(i, 8).Value = check.Cells(43, 4).Value
book1.Cells(i, 9).Value = check.Cells(45, 4).Value
fn = book1.Cells(i, 10).Value
check.SaveAs Filename:="Z:\66205_TEMPLATES_20996\" & fn
Next i
End Sub







Within a workbook, I have (2) worksheets that are dedicated to data entry. The first worksheet, 'Data' is intended for scheduling of personnel for the cells of machines that are supposed to run on any given day. The 'ProductionData' worksheet is intended to capture the # of good parts run on each of the machines within a machining cell for 4 specific increments of time on any given shift.

Key information from the 'Data' worksheet is copied over to the 'ProductionData' worksheet with the use of formulas.


So, for example, on the 'Data' worksheet

Col B= Date
Col C = Active Cell (VCM, M01, M03) one of these is selected with a drop down feature
Col D = Shift (1,2, or 3)
Col L & M = for personnel scheduling
Col N-AB = Data on current running jobs for a specific machine within the selected cell of machines (i.e. M28 machine within the M01 cell)

The above layout is repeated for up to 7 machines that could be active within a particular cell of machines.

On the 'ProductionData' worksheet, I have carried over (with a one-to-one correspondence of the active row and column from 'Data' worksheet columns B-D such that anyone looking at the second spreadsheet would know that the data for the jobs run is for the same group of machines as the machining cell on the 'Data' spreadsheet.


I have written a macro to try and pull specific data points from both the 'Data' worksheet and 'ProductionData' worksheet in order to populate both a cell Map and Calculations sheet for the designated machining cell within the same workbook.

When I try to run the below program, it does not pull the correct data from either worksheet that I have designated ('Data' and 'ProductionData')

Is it possible to write code to pull from more than one sheet and paste the values into other active worksheets within the same workbook? If so, can someone help me figure out how to correct the code below?

Thanks so much in advance for your help!











Sub RunM01()
' Dim X As Integer
Dim N As Integer

Dim Data As Worksheet
Dim M01Map As Worksheet
Dim ProductionData As Worksheet
Dim M01 As Worksheet

Set Data = Worksheets("Data")
Set M01Map = Worksheets("M01Map")
Set ProductionData = Worksheets("ProductionData")
Set M01 = Worksheets("M01")

Data.Activate
ProductionData.Activate

N = ActiveCell.Row

For X = 1 To 256
Select Case X
Case 1
M01Map.Cells(2, 14) = Data.Cells(N, 2) 'Date
Case 2
M01Map.Cells(2, 3) = Data.Cells(N, 4) 'Shift
Case 3
M01Map.Cells(19, 8) = Data.Cells(N, 5) 'Scheduler
Case 4
M01Map.Cells(21, 8) = Data.Cells(N, 6) 'Tech Support
Case 5
M01Map.Cells(23, 8) = Data.Cells(N, 7) 'S/u#1
Case 6
M01Map.Cells(25, 8) = Data.Cells(N, 8) 'S/u#2
Case 7
M01Map.Cells(27, 8) = Data.Cells(N, 9) '6S
Case 8
M01Map.Cells(13, 8) = Data.Cells(N, 11) 'Machine(1) Loader
Case 9
M01Map.Cells(14, 8) = Data.Cells(N, 12) 'Machine(1) Backup
Case 10
M01Map.Cells(15, 8) = Data.Cells(N, 13) 'Machine(1) Inspector
Case 11
M01Map.Cells(8, 8) = Data.Cells(N, 14) 'Job#1
Case 12
M01Map.Cells(9, 8) = Data.Cells(N, 15) 'W.O. Qty
Case 13
M01Map.Cells(10, 8) = Data.Cells(N, 16) 'Lot
Case 14
M01Map.Cells(11, 8) = Data.Cells(N, 17) 'Op
Case 15
M01Map.Cells(12, 8) = Data.Cells(N, 18) 'MPP
Case 16
M01Map.Cells(8, 10) = Data.Cells(N, 19) 'Job#2
Case 17
M01Map.Cells(9, 10) = Data.Cells(N, 20) 'W.O. Qty
Case 18
M01Map.Cells(10, 10) = Data.Cells(N, 21) 'Lot
Case 19
M01Map.Cells(11, 10) = Data.Cells(N, 22) 'Op
Case 20
M01Map.Cells(12, 10) = Data.Cells(N, 23) 'MPP
Case 21
M01Map.Cells(20, 3) = Data.Cells(N, 30) 'Machine(2) Loader
Case 22
M01Map.Cells(21, 3) = Data.Cells(N, 31) 'Machine(2) Backup
Case 23
M01Map.Cells(22, 3) = Data.Cells(N, 32) 'Machine(2) Inspector
Case 24
M01Map.Cells(15, 3) = Data.Cells(N, 33) 'Job#1
Case 25
M01Map.Cells(16, 3) = Data.Cells(N, 34) 'W.O. Qty
Case 26
M01Map.Cells(17, 3) = Data.Cells(N, 35) 'Lot
Case 27
M01Map.Cells(18, 3) = Data.Cells(N, 36) 'Op
Case 28
M01Map.Cells(19, 3) = Data.Cells(N, 37) 'MPP
Case 29
M01Map.Cells(15, 5) = Data.Cells(N, 38) 'Job#2
Case 30
M01Map.Cells(16, 5) = Data.Cells(N, 39) 'W.O. Qty
Case 31
M01Map.Cells(17, 5) = Data.Cells(N, 40) 'Lot
Case 32
M01Map.Cells(18, 5) = Data.Cells(N, 41) 'Op
Case 33
M01Map.Cells(19, 5) = Data.Cells(N, 42) 'MPP
Case 34
M01Map.Cells(20, 13) = Data.Cells(N, 49) 'Machine(3) Loader
Case 35
M01Map.Cells(21, 13) = Data.Cells(N, 50) 'Machine(3) Backup
Case 36
M01Map.Cells(22, 13) = Data.Cells(N, 51) 'Machine(3) Inspector
Case 37
M01Map.Cells(15, 13) = Data.Cells(N, 52) 'Job#1
Case 38
M01Map.Cells(16, 13) = Data.Cells(N, 53) 'W.O. Qty
Case 39
M01Map.Cells(17, 13) = Data.Cells(N, 54) 'Lot
Case 40
M01Map.Cells(18, 13) = Data.Cells(N, 55) 'Op
Case 41
M01Map.Cells(19, 13) = Data.Cells(N, 56) 'MPP
Case 42
M01Map.Cells(15, 15) = Data.Cells(N, 57) 'Job#2
Case 43
M01Map.Cells(16, 15) = Data.Cells(N, 58) 'W.O. Qty
Case 44
M01Map.Cells(17, 15) = Data.Cells(N, 59) 'Lot
Case 45
M01Map.Cells(18, 15) = Data.Cells(N, 60) 'Op
Case 46
M01Map.Cells(19, 15) = Data.Cells(N, 61) 'MPP
Case 47
M01.Cells(1, 32) = Data.Cells(N, 2) 'Date
Case 48
M01.Cells(1, 2) = Data.Cells(N, 4) 'Shift
Case 49
M01.Cells(5, 1) = Data.Cells(N, 14) 'Job(1)
Case 50
M01.Cells(5, 2) = Data.Cells(N, 15) 'Lot
Case 51
M01.Cells(5, 3) = Data.Cells(N, 16) 'Op
Case 52
M01.Cells(5, 4) = Data.Cells(N, 17) 'MPP
Case 53
M01.Cells(5, 5) = Data.Cells(N, 18) 'W.O. Qty
Case 54
M01.Cells(9, 1) = Data.Cells(N, 19) 'Job(2)
Case 55
M01.Cells(9, 2) = Data.Cells(N, 20) 'Lot
Case 56
M01.Cells(9, 3) = Data.Cells(N, 21) 'Op
Case 57
M01.Cells(9, 4) = Data.Cells(N, 22) 'MPP
Case 58
M01.Cells(9, 5) = Data.Cells(N, 23) 'W.O. Qty
Case 59
M01.Cells(13, 1) = Data.Cells(N, 24) 'Job(3)
Case 60
M01.Cells(13, 2) = Data.Cells(N, 25) 'Lot
Case 61
M01.Cells(13, 3) = Data.Cells(N, 26) 'Op
Case 62
M01.Cells(13, 4) = Data.Cells(N, 27) 'MPP
Case 63
M01.Cells(13, 5) = Data.Cells(N, 28) 'W.O. Qty
Case 64
M01.Cells(4, 10) = ProductionData.Cells(N, 6) 'Total # Parts Job(1)
Case 65
M01.Cells(6, 10) = ProductionData.Cells(N, 7) 'Total # NCM Job(1)
Case 66
M01.Cells(3, 53) = ProductionData.Cells(N, 8) 'Run Time Period(1); Job(1)
Case 67
M01.Cells(5, 13) = ProductionData.Cells(N, 9) '# Parts Job(1)
Case 68
M01.Cells(3, 54) = ProductionData.Cells(N, 10) 'Run Time Period(2); Job(1)
Case 69
M01.Cells(5, 18) = ProductionData.Cells(N, 11) '# Parts Job(1)
Case 70
M01.Cells(3, 55) = ProductionData.Cells(N, 12) 'Run Time Period(3); Job(1)
Case 71
M01.Cells(5, 23) = ProductionData.Cells(N, 13) '# Parts Job(1)
Case 72
M01.Cells(3, 56) = ProductionData.Cells(N, 14) 'Run Time Period(4); Job(1)
Case 73
M01.Cells(5, 28) = ProductionData.Cells(N, 15) '# Parts Job(1)
Case 74
M01.Cells(8, 10) = ProductionData.Cells(N, 16) 'Total # Parts Job(2)
Case 75
M01.Cells(10, 10) = ProductionData.Cells(N, 17) 'Total # NCM Job(2)
Case 76
M01.Cells(7, 53) = ProductionData.Cells(N, 18) 'Run Time Period(1); Job(2)
Case 77
M01.Cells(9, 13) = ProductionData.Cells(N, 19) '# Parts Job(2)
Case 78
M01.Cells(7, 54) = ProductionData.Cells(N, 20) 'Run Time Period(2); Job(2)
Case 79
M01.Cells(9, 18) = ProductionData.Cells(N, 21) '# Parts Job(2)
Case 80
M01.Cells(7, 55) = ProductionData.Cells(N, 22) 'Run Time Period(3); Job(2)
Case 81
M01.Cells(9, 23) = ProductionData.Cells(N, 23) '# Parts Job(2)
Case 82
M01.Cells(7, 56) = ProductionData.Cells(N, 24) 'Run Time Period(4); Job(2)
Case 83
M01.Cells(9, 28) = ProductionData.Cells(N, 25) '# Parts Job(2)
Case 84
M01.Cells(12, 10) = ProductionData.Cells(N, 26) 'Total # Parts Job(3)
Case 85
M01.Cells(14, 10) = ProductionData.Cells(N, 27) 'Total # NCM Job(3)
Case 86
M01.Cells(11, 53) = ProductionData.Cells(N, 28) 'Run Time Period(1); Job(3)
Case 87
M01.Cells(13, 13) = ProductionData.Cells(N, 29) '# Parts Job(3)
Case 88
M01.Cells(11, 54) = ProductionData.Cells(N, 30) 'Run Time Period(2); Job(3)
Case 89
M01.Cells(13, 18) = ProductionData.Cells(N, 31) '# Parts Job(3)
Case 90
M01.Cells(11, 55) = ProductionData.Cells(N, 32) 'Run Time Period(3); Job(3)
Case 91
M01.Cells(13, 23) = ProductionData.Cells(N, 33) '# Parts Job(3)
Case 92
M01.Cells(11, 56) = ProductionData.Cells(N, 34) 'Run Time Period(4); Job(3)
Case 93
M01.Cells(13, 28) = ProductionData.Cells(N, 35) '# Parts Job(3)
Case 94
M01.Cells(16, 10) = ProductionData.Cells(N, 37) 'Total # Parts Job(1)
Case 95
M01.Cells(18, 10) = ProductionData.Cells(N, 38) 'Total # NCM Job(1)
Case 96
M01.Cells(15, 53) = ProductionData.Cells(N, 39) 'Run Time Period(1); Job(1)
Case 97
M01.Cells(17, 13) = ProductionData.Cells(N, 40) '# Parts Job(1)
Case 98
M01.Cells(15, 54) = ProductionData.Cells(N, 41) 'Run Time Period(2); Job(1)
Case 99
M01.Cells(17, 18) = ProductionData.Cells(N, 42) '# Parts Job(1)
Case 100
M01.Cells(15, 55) = ProductionData.Cells(N, 43) 'Run Time Period(3); Job(1)
Case 101
M01.Cells(17, 23) = ProductionData.Cells(N, 44) '# Parts Job(1)
Case 102
M01.Cells(15, 56) = ProductionData.Cells(N, 45) 'Run Time Period(4); Job(1)
Case 103
M01.Cells(17, 28) = ProductionData.Cells(N, 46) '# Parts Job(1)
Case 104
M01.Cells(20, 10) = ProductionData.Cells(N, 47) 'Total # Parts Job(2)
Case 105
M01.Cells(22, 10) = ProductionData.Cells(N, 48) 'Total # NCM Job(2)
Case 106
M01.Cells(19, 53) = ProductionData.Cells(N, 49) 'Run Time Period(1); Job(2)
Case 107
M01.Cells(21, 13) = ProductionData.Cells(N, 50) '# Parts Job(2)
Case 108
M01.Cells(19, 54) = ProductionData.Cells(N, 51) 'Run Time Period(2); Job(2)
Case 109
M01.Cells(21, 18) = ProductionData.Cells(N, 52) '# Parts Job(2)
Case 110
M01.Cells(19, 55) = ProductionData.Cells(N, 53) 'Run Time Period(3); Job(2)
Case 111
M01.Cells(21, 23) = ProductionData.Cells(N, 54) '# Parts Job(2)
Case 112
M01.Cells(19, 56) = ProductionData.Cells(N, 55) 'Run Time Period(4); Job(2)
Case 113
M01.Cells(21, 28) = ProductionData.Cells(N, 56) '# Parts Job(2)
Case 114
M01.Cells(24, 10) = ProductionData.Cells(N, 57) 'Total # Parts Job(3)
Case 115
M01.Cells(26, 10) = ProductionData.Cells(N, 58) 'Total # NCM Job(3)
Case 116
M01.Cells(23, 53) = ProductionData.Cells(N, 59) 'Run Time Period(1); Job(3)
Case 117
M01.Cells(25, 13) = ProductionData.Cells(N, 60) '# Parts Job(3)
Case 118
M01.Cells(23, 54) = ProductionData.Cells(N, 61) 'Run Time Period(2); Job(3)
Case 119
M01.Cells(25, 18) = ProductionData.Cells(N, 62) '# Parts Job(3)
Case 120
M01.Cells(23, 55) = ProductionData.Cells(N, 63) 'Run Time Period(3); Job(3)
Case 121
M01.Cells(25, 23) = ProductionData.Cells(N, 64) '# Parts Job(3)
Case 122
M01.Cells(23, 56) = ProductionData.Cells(N, 65) 'Run Time Period(4); Job(3)
Case 123
M01.Cells(25, 28) = ProductionData.Cells(N, 66) '# Parts Job(3)



Case 124
M01.Cells(28, 10) = ProductionData.Cells(N, 68) 'Total # Parts Job(1)
Case 125
M01.Cells(29, 10) = ProductionData.Cells(N, 69) 'Total # NCM Job(1)
Case 126
M01.Cells(27, 53) = ProductionData.Cells(N, 70) 'Run Time Period(1); Job(1)
Case 127
M01.Cells(29, 13) = ProductionData.Cells(N, 71) '# Parts Job(1)
Case 128
M01.Cells(27, 54) = ProductionData.Cells(N, 72) 'Run Time Period(2); Job(1)
Case 129
M01.Cells(29, 18) = ProductionData.Cells(N, 73) '# Parts Job(1)
Case 130
M01.Cells(27, 55) = ProductionData.Cells(N, 74) 'Run Time Period(3); Job(1)
Case 131
M01.Cells(29, 23) = ProductionData.Cells(N, 75) '# Parts Job(1)
Case 132
M01.Cells(27, 56) = ProductionData.Cells(N, 76) 'Run Time Period(4); Job(1)
Case 133
M01.Cells(29, 28) = ProductionData.Cells(N, 77) '# Parts Job(1)
Case 134
M01.Cells(32, 10) = ProductionData.Cells(N, 78) 'Total # Parts Job(2)
Case 135
M01.Cells(34, 10) = ProductionData.Cells(N, 79) 'Total # NCM Job(2)
Case 136
M01.Cells(31, 53) = ProductionData.Cells(N, 80) 'Run Time Period(1); Job(2)
Case 137
M01.Cells(33, 13) = ProductionData.Cells(N, 81) '# Parts Job(2)
Case 138
M01.Cells(31, 54) = ProductionData.Cells(N, 82) 'Run Time Period(2); Job(2)
Case 139
M01.Cells(33, 18) = ProductionData.Cells(N, 83) '# Parts Job(2)
Case 140
M01.Cells(31, 55) = ProductionData.Cells(N, 84) 'Run Time Period(3); Job(2)
Case 141
M01.Cells(33, 23) = ProductionData.Cells(N, 85) '# Parts Job(2)
Case 142
M01.Cells(31, 56) = ProductionData.Cells(N, 86) 'Run Time Period(4); Job(2)
Case 143
M01.Cells(33, 28) = ProductionData.Cells(N, 87) '# Parts Job(2)
Case 144
M01.Cells(36, 10) = ProductionData.Cells(N, 88) 'Total # Parts Job(3)
Case 145
M01.Cells(38, 10) = ProductionData.Cells(N, 89) 'Total # NCM Job(3)
Case 146
M01.Cells(35, 53) = ProductionData.Cells(N, 90) 'Run Time Period(1); Job(3)
Case 147
M01.Cells(37, 13) = ProductionData.Cells(N, 91) '# Parts Job(3)
Case 148
M01.Cells(35, 54) = ProductionData.Cells(N, 92) 'Run Time Period(2); Job(3)
Case 149
M01.Cells(37, 18) = ProductionData.Cells(N, 93) '# Parts Job(3)
Case 150
M01.Cells(35, 55) = ProductionData.Cells(N, 94) 'Run Time Period(3); Job(3)
Case 151
M01.Cells(37, 23) = ProductionData.Cells(N, 95) '# Parts Job(3)
Case 152
M01.Cells(35, 56) = ProductionData.Cells(N, 96) 'Run Time Period(4); Job(3)
Case 153
M01.Cells(37, 28) = ProductionData.Cells(N, 97) '# Parts Job(3)


End Select
Next X


M01Map.Activate
M01.Activate
Data.Activate
ProductionData.Activate

End Sub


Good evening all, Yesterday I asked a question about automating a macro when switching from one worksheet to another. Erik van Geit kindly offered me the advice to use a "deactivate" code in the worksheet. Unfortunately, because of the way I have written the macro, using this code results in the programme getting in to a loop.

If I can explain further: The macro copies and pastes a row of cells from worksheet 1 to worksheet 2. However, using the "deactivate" event trigger, the macro does not start until worksheet 1 is closed, i.e. worksheet 2 is opened. At that point the macro returns to worksheet 1 to copy the cells. It then returns to worksheet 2 to paste the cells, but in doing so it closes worksheet1 and the macro kicks in again........ ad infinitum!!

Can I add a further element to the deactivate event code, so that the macro only runs when leaving worksheet 1 if there has been a change. If this is possible, then the macro would not be triggered for a second time when it leaves worksheet 1 after copying the cells.

I suppose another approach would be to have the macro run whenever a cell is changed in worksheet 1. I have seen the "Change(ByVal Target As Range)" event. This works if a value changes. Is there a similar command that triggers the macro if the format of a cell changes. e.g. its colour?

I know there are a few different questions here, but hope someone can advise.

Thanks, Dave


Hello all,

I'm putting together a table of contents, and I would like to know what the command was to put the page number of wherever the criteria is met.

The line would go right after the lines that look like so: Cells(6 + y, 7) = Cells(50 + x, 2)

Here is the code:

Thank you!

Code:

Sub TableofContents()
    
    Dim x As Integer
    Dim y As Integer
    
    x = 0
    y = 0
    
    Do While (y < 39)
        If Cells(49 + x, 1) = Cells(50 + x, 2) Then
         Cells(6 + y, 7) = Cells(50 + x, 2) 
        x = x + 1
        y = y + 1
        Else: x = x + 1
        End If
    Loop
    
    y = 0
    
    Do While (y < 39)
        If Cells(49 + x, 1) = Cells(50 + x, 2) Then
         Cells(6 + y, 9) = Cells(50 + x, 2) 
        x = x + 1
        y = y + 1
        Else: x = x + 1
        End If
    Loop
    
    y = 0
    
     Do While (y < 39)
        If Cells(49 + x, 1) = Cells(50 + x, 2) Then
         Cells(6 + y, 11) = Cells(50 + x, 2) 
        x = x + 1
        y = y + 1
        Else: x = x + 1
        End If
    Loop
    
    y = 0
    
      Do While (y < 39)
        If Cells(49 + x, 1) = Cells(50 + x, 2) Then
         Cells(6 + y, 13) = Cells(50 + x, 2) 
        x = x + 1
        y = y + 1
        Else: x = x + 1
        End If
    Loop
    
End Sub





I currently have a macro created which will take specified values from all of the excel workbooks in a certain directory and consolidate them onto a new master worksheet. The current code will perform the following mapping:

That is the data I'd like to extract, I would like to try and put it in a different format. For each xls file there should be 5 rows and 6 columns. I'd like to try and get the data in this format:


Date
Name
FTP G O H20







5/1/09
B21 C21 S21 T21 U21
5/1/09
B23 C23 S23 T23 U23
5/1/09
B26 C26 S26 T26 U26
5/1/09
B31 C31 S31 T31 U31
5/1/09
B33 C33 S33 T33 U33
The date will be the value in of the data in Cell G1, can't use just a copy and paste of the cell because it references an external location which is not available. Then for each sheet it would just add the next 5 rows under the 5 from the previous sheet.


The new set of workbooks I have contains data on a sheet labeled MARITECH and instead of using B21, C21, S21, T21, and U21 for a single row it will pull the date from Cell C4 and the data from the following cells:


Date
Name
FTP G O H20







C4
A7 F7 C7 D7
E7
C4
A8 F7 C8
D8 E8

C4
A9 F7 C9
D9
E9
If this doesnt make sense please let me know. Here's the current macro:

Sub aschaef_modified()
Dim z As Long, a As Long, d As Long, c As Long
Dim f As String, b As String
Sheets("Sheet1").Select
Cells(1, 1) = "=cell(""filename"")"
Cells(1, 2) = "=left(A1,find(""["",A1)-1)"
Cells(3, 1).Select
f = Dir(Cells(1, 2) & "*.xls")
Do While Len(f) > 0
ActiveCell.Formula = f
ActiveCell.Offset(1, 0).Select
f = Dir()
Loop
z = Cells(Rows.Count, 1).End(xlUp).Row
For e = 3 To z
If Cells(e, 1) ActiveWorkbook.Name Then
For a = 1 To 5

Cells((e - 3) * 5 + 3, 2) = Cells(e, 1)
For d = 1 To 5
Cells(1, 4) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]VR 119-124'!G1"
Cells((e - 3) * 5 + d + 2, 3) = Cells(1, 4)
c = Choose(d, 21, 23, 26, 31, 33)
b = Choose(a, "B", "C", "S", "T", "U")
Cells(1, 3) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]VR 119-124'!" & b & c
Cells((e - 3) * 5 + d + 2, a + 3) = Cells(1, 3)
Next d
Next a
End If
Next e
Range("A1:D1").ClearContents
MsgBox "collating is complete."
End Sub

Thanks,
Andrew


Hi I am using the following code it takes a lot of time to execute pls could someone refine it

Code:

'Data Total
Dim C As Integer
C = 2
For C = 2 To 100
    If LTrim(Sheets("DW").Cells(C, 1)) = "" Then Exit For
    Do While Sheets("DW").Cells(C, 1) = Sheets("DW").Cells(C + 1, 1)
        Sheets("DW").Cells(C, 2) = Sheets("DW").Cells(C, 2) + Sheets("DW").Cells(C + 1, 2)
        Sheets("DW").Cells(C, 3) = Sheets("DW").Cells(C, 3) + Sheets("DW").Cells(C + 1, 3)
        Sheets("DW").Cells(C, 4) = Sheets("DW").Cells(C, 4) + Sheets("DW").Cells(C + 1, 4)
        Sheets("DW").Cells(C, 5) = Sheets("DW").Cells(C, 5) + Sheets("DW").Cells(C + 1, 5)
        Sheets("DW").Cells(C, 6) = Sheets("DW").Cells(C, 6) + Sheets("DW").Cells(C + 1, 6)
        Sheets("DW").Cells(C, 7) = Sheets("DW").Cells(C, 7) + Sheets("DW").Cells(C + 1, 7)
        Sheets("DW").Cells(C, 8) = Sheets("DW").Cells(C, 8) + Sheets("DW").Cells(C + 1, 8)
        Sheets("DW").Cells(C, 9) = Sheets("DW").Cells(C, 9) + Sheets("DW").Cells(C + 1, 9)
        Sheets("DW").Cells(C, 10) = Sheets("DW").Cells(C, 10) + Sheets("DW").Cells(C + 1, 10)
        Sheets("DW").Cells(C, 11) = Sheets("DW").Cells(C, 11) + Sheets("DW").Cells(C + 1, 11)
    'Delete Row
        Sheets("DW").Cells(C + 1, 1).Select
        Selection.EntireRow.Delete
        C = C - 1
    Loop
Next C





I am trying to sum cells from different spreadsheets. For Example: I want to sum information from Worksheet 1, 2 and 3. From worksheet 1 the cells are C2-C27, the cells on Worksheet 2 are C2-C26 and worksheet 3 the cells are C2-C26.

I am also trying to average cells from different spreadsheets. For Example: I want to average information from Worksheet 1, 2 and 3. From worksheet 1 the cells are G2-G27, the cells on Worksheet 2 are G2-G26 and worksheet 3 the cells are G2-G26.

I tried to use the point click method to select the cells to use in the formula, but it keeps telling me there is an error.

Thanks in advance for your help.

I am looking into a worksheet created by someone who has since left the company. A couple of the cells allow me to type over the formula, even though theyare checked as protected. I have checked the following...
The worksheet is definitely protected. I try to type into other protected cells and I receive the standard error. The cells are not part of any ranges. There are only 3 or 4 named ranges in the workbook. I have commented out the only subroutine of VBA code in the entire workbook, which is a Worksheet_Change event. the only two boxes checked in the Protect Cells panel are the top two, "select protected cells" and "select unprotected cells" Any ideas?


Hello!
I pull a report daily that pulls ticketing information. Each ticket has a different tracker, and the report is not sorted by tracker, but by time. Each tracker has their own workbook, with a sheet for each day. I was able to create (rather messy) code that searches for the tracker (which is listed in "E" on the daily report), copies the needed cells (which happens to be the entire row that the tracker's name is in) and pasts them into the individual's workbook on the correct day. However, the cells are being copied into the individual's workbook in the same order they were listed in the daily report. This means I am getting gaps between the rows of data.

I'm new to VBA and I suprised myself making what I have. I would appreciate any help cleaning it up and actually getting the data to paste properly on the individual's workbook.

Cheers!

George

Code:

 
Sub DataCopy()
Dim AHT As Worksheet
Dim AWB As Worksheet
Dim sRow As Long
Dim dRow As Long
Dim sCount As Long
 
AHTWB = InputBox("All Heat Ticket workbook name like 0507.xls")
SheetDate = InputBox("Sheet Date data is being copied too like May7")
 
Set AHT = Workbooks(AHTWB).Sheets("All Heat Tickets")
sCount = 0
dRow = 4
For sRow = 1 To Range("E65536").End(xlUp).Row
    If Cells(sRow, "E") Like "*jdoe*" Then
    Set AWB = Workbooks("JohnMay.xls").Sheets(SheetDate)
    sCount = sCount + 1
    dRow = dRow + 1
    Cells(sRow, "A").Copy Destination:=AWB.Cells(dRow, "T")
    Cells(sRow, "B").Copy Destination:=AWB.Cells(dRow, "U")
    Cells(sRow, "C").Copy Destination:=AWB.Cells(dRow, "V")
    Cells(sRow, "D").Copy Destination:=AWB.Cells(dRow, "W")
    Cells(sRow, "E").Copy Destination:=AWB.Cells(dRow, "X")
    Cells(sRow, "F").Copy Destination:=AWB.Cells(dRow, "Y")
    Cells(sRow, "G").Copy Destination:=AWB.Cells(dRow, "Z")
    Cells(sRow, "H").Copy Destination:=AWB.Cells(dRow, "AA")
    Cells(sRow, "I").Copy Destination:=AWB.Cells(dRow, "AB")
    Cells(sRow, "J").Copy Destination:=AWB.Cells(dRow, "AC")
    Cells(sRow, "K").Copy Destination:=AWB.Cells(dRow, "AD")
    Cells(sRow, "L").Copy Destination:=AWB.Cells(dRow, "AE")
    Cells(sRow, "M").Copy Destination:=AWB.Cells(dRow, "AF")
    Cells(sRow, "N").Copy Destination:=AWB.Cells(dRow, "AG")
    Cells(sRow, "O").Copy Destination:=AWB.Cells(dRow, "AH")
    Cells(sRow, "P").Copy Destination:=AWB.Cells(dRow, "AI")
    Else
    If Cells(sRow, "E") Like "*BSmith*" Then
    Set AWB = Workbooks("BobMay.xls").Sheets(SheetDate)
    sCount = sCount + 1
    dRow = dRow + 1
    Cells(sRow, "A").Copy Destination:=AWB.Cells(dRow, "T")
    Cells(sRow, "B").Copy Destination:=AWB.Cells(dRow, "U")
    Cells(sRow, "C").Copy Destination:=AWB.Cells(dRow, "V")
    Cells(sRow, "D").Copy Destination:=AWB.Cells(dRow, "W")
    Cells(sRow, "E").Copy Destination:=AWB.Cells(dRow, "X")
    Cells(sRow, "F").Copy Destination:=AWB.Cells(dRow, "Y")
    Cells(sRow, "G").Copy Destination:=AWB.Cells(dRow, "Z")
    Cells(sRow, "H").Copy Destination:=AWB.Cells(dRow, "AA")
    Cells(sRow, "I").Copy Destination:=AWB.Cells(dRow, "AB")
    Cells(sRow, "J").Copy Destination:=AWB.Cells(dRow, "AC")
    Cells(sRow, "K").Copy Destination:=AWB.Cells(dRow, "AD")
    Cells(sRow, "L").Copy Destination:=AWB.Cells(dRow, "AE")
    Cells(sRow, "M").Copy Destination:=AWB.Cells(dRow, "AF")
    Cells(sRow, "N").Copy Destination:=AWB.Cells(dRow, "AG")
    Cells(sRow, "O").Copy Destination:=AWB.Cells(dRow, "AH")
    Cells(sRow, "P").Copy Destination:=AWB.Cells(dRow, "AI")
    Else
    End If
    If Cells(sRow, "E") Like "*HCarry*" Then
    Set AWB = Workbooks("HarryMay.xls").Sheets(SheetDate)
    sCount = sCount + 1
    dRow = dRow + 1
    Cells(sRow, "A").Copy Destination:=AWB.Cells(dRow, "T")
    Cells(sRow, "B").Copy Destination:=AWB.Cells(dRow, "U")
    Cells(sRow, "C").Copy Destination:=AWB.Cells(dRow, "V")
    Cells(sRow, "D").Copy Destination:=AWB.Cells(dRow, "W")
    Cells(sRow, "E").Copy Destination:=AWB.Cells(dRow, "X")
    Cells(sRow, "F").Copy Destination:=AWB.Cells(dRow, "Y")
    Cells(sRow, "G").Copy Destination:=AWB.Cells(dRow, "Z")
    Cells(sRow, "H").Copy Destination:=AWB.Cells(dRow, "AA")
    Cells(sRow, "I").Copy Destination:=AWB.Cells(dRow, "AB")
    Cells(sRow, "J").Copy Destination:=AWB.Cells(dRow, "AC")
    Cells(sRow, "K").Copy Destination:=AWB.Cells(dRow, "AD")
    Cells(sRow, "L").Copy Destination:=AWB.Cells(dRow, "AE")
    Cells(sRow, "M").Copy Destination:=AWB.Cells(dRow, "AF")
    Cells(sRow, "N").Copy Destination:=AWB.Cells(dRow, "AG")
    Cells(sRow, "O").Copy Destination:=AWB.Cells(dRow, "AH")
    Cells(sRow, "P").Copy Destination:=AWB.Cells(dRow, "AI")
    Else
    End If
    End If
Next sRow
....





Here is my code sample:
Code:

Dim r As Integer
    r = 2
    Do While IsEmpty(Cells(r, 16)) = False
    Cells(r, 20).Value = Cells(r, 15).Value
    Cells(r, 21).Value = Cells(r, 16).Value
    If Cells(r, 15).Value > Cells(r, 13).Value Or Cells(r, 15).Value < Cells(r, 14).Value Then r = r + 1
    Else: If Cells(r, 15).Value < Cells(r, 13).Value Or Cells(r, 15).Value > Cell Then r = r + 24
    End If
    Loop


Why do i keep getting this Else without If error when I already have an endif and an else if statement?


Hello Everyone,

Currently my main function is looping through the rows in the worksheet and making changes to different columns as it iterates through all of the data. In one column I have a telephone that is in a format I want changed:

(NPA) NXX-XXXX corrected to NPANXXXXXX
I.E. (408) 555-1212 to 4085551212

What I am trying to do is use another function that will chop up the telephone number and return the "corrected #" and then save the new value to the cell in the corresponding row. The problem I run into is when I compile the code I get

"Compile Error:

ByRef argument type mismatch"

Below is a sample of the code I am using

Code:

Function Prep_TestCCName()

' ******************** Detail for this Procedure ********************
'
Dim LastRow As Double                               ' Holds value for count of rows in WS

    LastRow = ActiveSheet.UsedRange.Rows.Count      ' Finds last 'row' in WS

    For RowNumber = 2 To LastRow                    ' Start Loop
       
        Call Prep_ReFormatCTN(CTNasNumber)            ' See Procedure for details
        Cells(RowNumber, 3).Value = CTNasNumber
  
    Next RowNumber                                  ' Move to next row in WS

End Function

Function Prep_ReFormatCTN(CTNasNumber As String) As Integer

' ******************** Detail for this Procedure ********************

    If Len(Cells(RowNumber, 3).Value < 1) Then      ' Cell is empty
        CTNasNumber = Cells(RowNumber, 3).Value
    Else                                            ' Has a telephone #, format to NPANXXXXXX
        CTNasNumber = Mid(Cells(RowNumber, 3), 2, 3) & _
                    Mid(Cells(RowNumber, 3), 7, 3) & _
                    Mid(Cells(RowNumber, 3), 11, 4)
    End If

End Function


I have tried to modify my second function and change how the variable is being handled and the problem persists.

Code:

Function Prep_ReFormatCTN(CTNasNumber As String) As Integer
Function Prep_ReFormatCTN(CTNasNumber As String) As Double
Function Prep_ReFormatCTN(CTNasNumber As String) As String

' Or

Function Prep_ReFormatCTN(ByVal CTNasNumber As String) As Integer
Function Prep_ReFormatCTN(ByRef CTNasNumber As String) As Integer


I am sure it is something simple I am missing .. any idea's would be helpful.

Thank you everyone for your time,

Jason S