· 6 years ago · Aug 02, 2019, 10:40 PM
1Option Explicit
2
3Sub Master()
4
5 Dim lastCol As Long
6 Dim lastRow As Long
7 Dim wsGPL As Worksheet
8 Dim wbGPL As Workbook
9
10 If MsgBox("This is a demanding macro. Please be sure to save any other work to avoid losing it. This will take about 5 minutes. Ready to start?", vbYesNo) = vbNo Then Exit Sub
11
12 Application.ScreenUpdating = False
13
14 'Variable for main worksheet
15 Set wsGPL = Sheets("Group_PositionList")
16
17 'These are used in a few places, might as well carry it through subs that update the table
18 lastRow = wsGPL.Cells(Rows.Count, 1).End(xlUp).Row
19 lastCol = wsGPL.Cells(1, Columns.Count).End(xlToLeft).Column
20
21 '\\//CAO Processes
22 Call RemoveDashOnes(lastRow)
23 Call CAO_Report(lastRow, lastCol)
24 Call CAO_Breakout(lastRow)
25 Call CAO_Clean
26 '//\\
27
28 'Delete Max Facings Column
29 ActiveWorkbook.Sheets("Group_PositionList").Activate
30 wsGPL.Range("K1").EntireColumn.Delete
31
32 'Convert all movements & counts to numbers
33
34 ActiveSheet.Range(Cells(2, 5), Cells(lastRow, lastCol)).Select
35 With Selection
36 .NumberFormat = "General"
37 .Value = .Value
38 End With
39
40 'Get Estimated Reset Inventory, this tells the inventory for the additional stores carrying each item.
41 'Change all POG UPC counts to 1
42 Call GetERI
43
44 'Build Additional Stores Using Item Sheet
45 With ActiveWorkbook
46 .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "Addtnl Strs Per Item"
47 End With
48 wsGPL.Activate
49
50 '=====Copy the data=====
51 wsGPL.Range("A1:F" & Range("F" & Rows.Count).End(xlUp).Row).Copy
52 'Activate the destination worksheet
53 Sheets("Addtnl Strs Per Item").Activate
54 'Select the target range
55 Range("A1").Select
56 'Paste in the target destination
57 ActiveSheet.Paste
58 Application.CutCopyMode = False
59
60 wsGPL.Activate
61 wsGPL.Range("J1:J" & Range("J" & Rows.Count).End(xlUp).Row).Copy
62 'Activate the destination worksheet
63 Sheets("Addtnl Strs Per Item").Activate
64 'Select the target range
65 Range("G1").Select
66 'Paste in the target destination
67 ActiveSheet.Paste
68 Application.CutCopyMode = False
69
70 '=====From Copy Headers=====
71 'Find Last Column Used
72 lastCol = wsGPL.Cells(1, Columns.Count).End(xlToLeft).Column
73 lastRow = wsGPL.Cells(Rows.Count, 1).End(xlUp).Row
74 'Copy through last header
75 wsGPL.Select
76 ActiveSheet.Range(Cells(1, 11), Cells(lastRow, lastCol - 1)).Select
77 Selection.Copy
78 'Activate Target Worksheet
79 Sheets("Addtnl Strs Per Item").Activate
80 'Select Target Range
81 Range("H1").Select
82 'Paste in Target Destination
83 ActiveSheet.Paste
84 Application.CutCopyMode = False
85 ActiveSheet.Cells.EntireColumn.AutoFit
86
87
88
89 '=====Run Input Macros=====
90
91 'Run Input_PoG_Usage
92 Call Input_PoG_Usage
93
94'Add header to last column
95 With ActiveSheet
96 Range("A1").End(xlToRight).Select
97 ActiveCell.Offset(, 1).Activate
98'Changed from Number of stores carrying item
99 ActiveCell.Value = "Change in stores carrying"
100
101'Color Store Count
102 .Range("A1").End(xlToRight).Select
103 Selection.EntireColumn.Interior.Color = RGB(200, 200, 200)
104 End With
105
106'Run BuyerWarehouse
107 Call BuyerWarehouse
108
109'Run Calculate
110 Call Calculate
111
112'=====Formatting=====
113
114'Color Rows based on Max Position Count
115 Range("A2:G" & Range("G" & Rows.Count).End(xlUp).Row).Select
116 Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$G2=0"
117 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
118 With Selection.FormatConditions(1).Interior
119 .PatternColorIndex = xlAutomatic
120 .Color = 6908415
121 .TintAndShade = 0
122 End With
123 Selection.FormatConditions(1).StopIfTrue = False
124
125'Freeze Top Row, Rename Headers, & AutoFit Columns
126Rows("2:2").Select
127 With ActiveWindow
128 .SplitColumn = 0
129 .SplitRow = 1
130 End With
131 ActiveWindow.FreezePanes = True
132With ActiveSheet
133 .Range("A1").Value = "Order #"
134 .Range("B1").Value = "UPC"
135 .Range("E1").Value = "Current Store Count"
136 .Range("F1").Value = "Mvmnt"
137 .Cells.EntireColumn.AutoFit
138 .Range("A1").Select
139End With
140
141'Add Title & Reset Date
142 Rows("1:1").Select
143 Selection.Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
144 Range("A1").Value = Application.InputBox("Buyer Report Title?")
145 Range("A2").Select
146 Selection.End(xlToRight).Select
147 Selection.Offset(-1, -2).Value = "Reset Date: "
148 Selection.Offset(-1, -2).HorizontalAlignment = xlRight
149 Selection.Offset(-1, -1).Value = Application.InputBox("Reset Date?")
150 Selection.Offset(-1, -1).HorizontalAlignment = xlLeft
151 Set wbGPL = ActiveWorkbook
152'CAO Relocate
153 Call CAO_Relocate_New
154
155'Add Estimated Reset Inventory and multiply by Change in store count.
156 wsGPL.Activate
157 ActiveSheet.Range("A1").Select
158 Selection.End(xlToRight).Select
159 Selection.Offset(, -1).Select
160 Range(Selection, Selection.End(xlDown)).Select
161 Selection.Offset(, 1).Select
162 Selection.Copy
163
164'Activate the destination worksheet
165 Sheets("Addtnl Strs Per Item").Activate
166'Select the target range
167 With ActiveSheet
168 Range("A2").End(xlToRight).Select
169 ActiveCell.Offset(, 1).Select
170 End With
171'Paste in the target destination
172 ActiveSheet.Paste
173 Application.CutCopyMode = False
174 With ActiveSheet
175 .Cells.EntireColumn.AutoFit
176 .Range("A:A").ColumnWidth = 9.6
177 End With
178'Multiply by change in store count
179Dim e As Long, f As Long, chng As Long
180
181 With Sheets("Addtnl Strs Per Item")
182 lastCol = .Cells(2, Columns.Count).End(xlToLeft).Column
183 lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
184 chng = .Cells(3, lastCol - 3).Column
185
186 For e = 3 To lastRow
187 For f = lastCol To lastCol
188 If Cells(e, lastCol).Value > 0 Then
189 If Cells(e, lastCol).Value = "" Then
190 Cells(e, lastCol).Value = "0"
191 End If
192 Cells(e, lastCol) = Cells(e, lastCol) * Cells(e, chng)
193 End If
194 Next
195 Next e
196 .Cells(1, lastCol).ColumnWidth = 11.25
197 .Range(Cells(3, lastCol), Cells(lastRow, lastCol)).Interior.ColorIndex = 43
198 .Range(Cells(3, lastCol), Cells(lastRow, lastCol)).EntireColumn.NumberFormat = "0"
199 .Cells(2, lastCol).Value = "Est Reset Inv"
200
201 For e = 3 To lastRow
202 If Round(Cells(e, lastCol)) < .Cells(e, chng) Then
203 .Cells(e, chng).Interior.ColorIndex = 43
204 .Cells(e, lastCol).Interior.ColorIndex = 46
205 End If
206 Next e
207 End With
208
209'Hide POG Columns
210 Range("H1").Select
211 Range(Selection, Selection.End(xlToRight)).Select
212 Selection.EntireColumn.Hidden = True
213 Range("A2").End(xlToRight).Select
214 Selection.Offset(, -3).EntireColumn.Hidden = False
215
216
217'Buyer Name Lookup
218 Range("A2").End(xlToRight).Select
219 Selection.Offset(, 1).Select
220 Selection.Value = "Buyer Name"
221 Selection.Offset(, -2).EntireColumn.NumberFormat = "General"
222 Selection.Value = Selection.Value
223
224 Selection.Offset(1, 0).Activate
225 ActiveCell.FormulaR1C1 = _
226 "=IF(RC[-2]>1,VLOOKUP(RC[-2],'[Buyer Report Generator V6 (Working).xlsm]Buyer_Report_Generator'!R2C1:R38C2,2,FALSE),"""")"
227
228 lastRow = Range("B2").End(xlDown).Row
229 ActiveCell.AutoFill Range(ActiveCell.Address, Cells(lastRow, ActiveCell.Column))
230
231
232'Paste Values
233 Range("A2").Select
234 Selection.End(xlToRight).Select
235 Selection.EntireColumn.Copy
236
237 Range("A2").End(xlToRight).Select
238 Selection.Offset(-1, 0).Select
239
240 Selection.PasteSpecial Paste:=xlPasteValues
241 Application.CutCopyMode = False
242
243'Final AutoFit & add filters
244 ActiveSheet.Range("A2").End(xlToRight).Select
245 Selection.EntireColumn.AutoFit
246 ActiveSheet.Range("A2").AutoFilter
247 ActiveSheet.Range("A1").Select
248
249'Hide Group_PositionList Sheet
250 wsGPL.Visible = False
251
252 'Workbooks("Buyer Report Generator V6 (Working).xlsm").Close False
253 wbGPL.Sheets("Addtnl Strs Per Item").Activate
254 MsgBox "Macro Complete"
255
256End Sub
257Sub RemoveDashOnes(ByRef lastRow As Long)
258 Dim i As Long
259
260 For i = lastRow To 2 Step -1
261 If Right(Cells(i, 2).Value, 2) = "-1" Then
262 Cells(i, 2).EntireRow.Delete shift:=xlUp
263 lastRow = lastRow - 1
264 End If
265 Next
266
267End Sub
268Sub CAO_Report(ByVal lastRow As Long, ByVal lastCol As Long)
269 'Dim lastCol as long 'Since these are copies you can just take the lastrow and lastCol from the other place
270 'Dim lastRow as long
271 Dim i As Long
272 Dim rng As Range
273 Dim strReplace As String
274 Dim strStoreNumber As String
275 Dim arrP_ID() As Variant
276
277 'Create new tab - Yeah, but why?
278 ActiveSheet.Copy After:=Worksheets(Sheets.Count)
279 ActiveSheet.Name = "Distribution"
280 ActiveSheet.Copy After:=Worksheets(Sheets.Count)
281 ActiveSheet.Name = "CAO Report"
282 Range("A:A").EntireColumn.Delete '1 column deleted
283 Range("B:J").EntireColumn.Delete '9 columns deleted
284
285 lastCol = lastCol - 10 '1 + 9 = 10
286
287 'Format new tab and strip down to needed data
288 Set rng = Range("A2:A" & lastRow)
289
290
291 'Format ye olde product IDs
292 arrP_ID = rng
293 For i = LBound(arrP_ID, 1) To UBound(arrP_ID, 1)
294 arrP_ID(i, 1) = Left(CStr(arrP_ID(i, 1)), Len(arrP_ID(i, 1)) - 1)
295 Next i
296 rng = arrP_ID
297 rng.NumberFormat = "0000000000000"
298 rng.ColumnWidth = 14
299
300 'Pull store numbers from POG names
301 For i = 2 To lastCol
302 strStoreNumber = Cells(1, i).Value
303 strReplace = Mid(strStoreNumber, Len(strStoreNumber) - 6, 3)
304 Cells(1, i).Value = strReplace
305 Next i
306
307 Set rng = Nothing
308 Erase arrP_ID
309
310End Sub
311Sub CAO_Breakout(ByVal lastRow As Long)
312
313 Dim rP_ID As Range
314 Dim i As Long
315 Dim lastCol As Long
316 Dim strStore As String
317 Dim wsCAO As Worksheet
318 Dim wsDuplicate As Worksheet
319
320 Set wsCAO = ActiveWorkbook.Worksheets("CAO Report")
321 lastCol = wsCAO.Cells(1, Columns.Count).End(xlToLeft).Column
322 Set rP_ID = wsCAO.Range("A1:A" & lastRow)
323
324 'Looper makes new tab for store, if it already exists, go to "ExistingStrNum"
325 On Error GoTo ExistingStrNum
326
327 For i = lastCol To 2 Step -1
328 Sheets.Add(After:=Sheets(Sheets.Count)).Name = wsCAO.Cells(1, i).Value
329 Range("A1:A" & lastRow).Value = rP_ID.Value
330 Range("A1").ColumnWidth = 14
331 Range("A2:A" & lastRow).NumberFormat = "0000000000000"
332 Range("B1:B" & lastRow).Value = wsCAO.Range(wsCAO.Cells(1, i), wsCAO.Cells(lastRow, i)).Value
333
334Looper:
335 Next i
336
337DeleteAndExit:
338 '\\//When loop finishes, delete empty CAO report sheet and exit
339 Application.DisplayAlerts = False
340 wsCAO.Delete
341 Application.DisplayAlerts = True
342
343 Set rP_ID = Nothing
344 Set wsCAO = Nothing
345 Set wsDuplicate = Nothing
346
347 Exit Sub
348
349 'Add duplicate store number data to existing tab
350ExistingStrNum:
351 Application.DisplayAlerts = False
352 ActiveSheet.Delete
353 Application.DisplayAlerts = True
354
355 strStore = CStr(wsCAO.Cells(1, i))
356
357 If strStore <> "" Then
358 Set wsDuplicate = Sheets(strStore)
359 wsDuplicate.Activate
360 Else
361 GoTo DeleteAndExit
362 End If
363
364 'When you find a duplicate, add it to the existing totals
365 'vvv u/Aftermathrar 's solution to summing the rows upon duplicates.
366 Call SumDuplicateStoreData(wsDuplicate.Range(wsDuplicate.Cells(2, 2), wsDuplicate.Cells(lastRow, 2)), wsCAO.Range("B2:B" & lastRow))
367
368
369
370 Resume Looper
371
372End Sub
373'Add existing data and duplicate store data together, write in duplicate worksheet
374Private Sub SumDuplicateStoreData(ByRef rngDest As Range, ByRef rngCAO As Range)
375 Dim arrTotal() As Variant
376 Dim arrDuplicate() As Variant
377 Dim i As Long
378
379 arrTotal = rngDest.Value 'Existing data
380 arrDuplicate = rngCAO.Value 'New data
381
382 'Should put a check to make sure it's an array
383
384 For i = LBound(arrTotal, 2) To UBound(arrTotal, 2)
385
386 'If existing data is blank, but new data has a number value, overwrite
387 If arrTotal(i, 1) = Empty And arrDuplicate(i, 1) <> Empty Then
388 arrTotal(i, 1) = arrDuplicate(i, 1)
389
390 'If new data and existing data have number values, add them together
391 ElseIf IsNumeric(arrDuplicate(i, 2)) And IsNumeric(arrTotal(i, 2)) Then
392 arrTotal(i, 2) = arrTotal(i, 2) + arrDuplicate(i, 2)
393
394 'Otherwise, set data to 0
395 Else
396 arrTotal(i, 2) = 0
397 End If
398
399 Next i
400
401 'Write summed values back to sheet
402 rngDest.Value = arrTotal
403
404 Erase arrTotal
405 Erase arrDuplicate
406
407End Sub
408Sub CAO_Clean()
409
410 Dim sht As Worksheet
411 Dim rngTemp As Range
412
413 For Each sht In ActiveWorkbook.Worksheets
414 Select Case sht.Name
415 Case "Group_PositionList", "Distribution"
416 'do nothing
417 Case Else
418 'Filter for zero values
419 sht.UsedRange.AutoFilter field:=1, Criteria1:="<>"
420 sht.UsedRange.AutoFilter field:=2, Criteria1:="0", Operator:=xlOr, Criteria2:=""
421 'Offset needed to spare the headers, I think
422 Set rngTemp = sht.AutoFilter.Range.Offset(1, 0)
423 'Delete filtered range
424 Application.DisplayAlerts = False
425 rngTemp.Delete
426 Application.DisplayAlerts = True
427 sht.AutoFilterMode = False
428 End Select
429 Next sht
430
431End Sub
432Sub GetERI()
433
434 'Estimated Reset Inventory
435 'Divide each POG's Units on Shelf by Each item's Units_Case, then average each line into new column.
436 'This will be multiplied by change in store count.
437 Dim e As Long, lastRow As Long, lastCol As Long, f As Long, rng As Range, rng2 As Range, wsGPL As Worksheet, cell As Range
438
439 Set wsGPL = ActiveWorkbook.Sheets("Group_PositionList")
440
441 With wsGPL
442 lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
443 lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
444
445 Set rng = Range(Cells(2, 11), Cells(lastRow, lastCol))
446
447 'Change 0s to empty
448 For Each cell In rng
449 If cell.Value = 0 Then
450 cell.Value = Empty
451 ElseIf cell.Value <> 0 Then
452 cell.Value = cell.Value
453 End If
454 Next
455
456 'Divide each PoGs' Units on Shelf by each item's Units_Case, then average each line into new column if value is not 0
457 rng.NumberFormat = "General"
458 rng.Value = rng.Value
459 For e = 2 To lastRow
460 For f = 11 To lastCol
461 If Cells(e, f).Value <> Empty Then
462 Cells(e, f).Value = .Cells(e, f).Value / Cells(e, 9).Value
463 'Cells(e, f).NumberFormat = "0.00"
464 Cells(e, lastCol + 1).Value = Application.WorksheetFunction.AverageIf(Range(Cells(e, 11), Cells(e, lastCol)), ">0")
465 End If
466 Next
467 Next e
468
469 'Format new column
470 Range("A1").Select
471 Selection.End(xlToRight).Offset(, 1).Select
472 Selection.Value = "Avg Cs Pk"
473 Selection.EntireColumn.NumberFormat = "0.00"
474
475 'If a value on Group Position List is more than .01, make it 1. If not, make it 0.
476
477 For Each cell In rng
478 If cell.Value <> Empty Then
479 cell.Value = 1
480 ElseIf cell.Value = Empty Then
481 cell.Value = 0
482 cell.NumberFormat = "0"
483 End If
484 Next
485
486 End With
487
488 Dim g As Long, lastcol2 As Long
489 For g = 2 To lastRow
490 lastcol2 = wsGPL.Cells(1, Columns.Count).End(xlToLeft).Column
491 If Cells(g, lastCol).Value = "" Then
492 Cells(g, lastCol) = "0"
493 End If
494 Next
495
496End Sub
497Sub Input_PoG_Usage()
498 'Taken from Stackoverflow.com
499 Dim sht As Worksheet, lastCol As Long, lastRow As Long, multiplier As Integer
500 Dim i As Long, j As Long
501
502 Set sht = ActiveWorkbook.Worksheets("Addtnl Strs Per Item")
503 lastCol = sht.Cells(1, sht.Columns.Count).End(xlToLeft).Column
504
505 Application.ScreenUpdating = False
506 'Double For Loop
507 For i = 8 To lastCol
508 If Cells(1, i) <> vbNullString Then
509
510 ' \\// Set so that every pog will be used one time; the code below in green will offer the input box for variable usages.
511 'multiplier = 1
512 ' //\\Application.InputBox("Number of stores using set " & Cells(1, i) & ".", , 1)
513 lastRow = sht.Cells(sht.Rows.Count, 5).End(xlUp).Row
514
515 For j = 2 To lastRow
516 If Cells(j, i) = "" Then
517 Cells(j, i) = "0"
518 End If
519 Cells(j, i) = 1 * Cells(j, i) 'Replace 1 with Multiplier if needed
520 Next j
521 End If
522 Next i
523 Application.ScreenUpdating = False
524
525End Sub
526Sub BuyerWarehouse()
527
528Dim lastCol As Long, wsGPL As Worksheet
529
530Set wsGPL = ActiveWorkbook.Sheets("Group_PositionList")
531
532 With ActiveSheet.Select
533 Range("A1").End(xlToRight).Select
534 End With
535 ActiveCell.Offset(, 1).Activate
536 ActiveCell.Value = "Warehouse"
537 ActiveCell.Offset(, 1).Activate
538 ActiveCell.Value = "Buyer Number"
539
540 lastCol = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
541
542 'Copy the data
543 wsGPL.Range("G2:H" & Range("H" & Rows.Count).End(xlUp).Row).Copy
544 'Activate the destination worksheet
545 Sheets("Addtnl Strs Per Item").Activate
546 'Select the target range
547 Cells(2, lastCol - 1).Select
548 'Paste in the target destination
549 ActiveSheet.Paste
550 Application.CutCopyMode = False
551
552End Sub
553Sub Calculate()
554
555 Dim i As Long, lastCol As Long, sht As Worksheet, lastRow As Long
556
557 Set sht = ActiveWorkbook.Worksheets("Addtnl Strs Per Item")
558 lastCol = sht.Cells(1, sht.Columns.Count).End(xlToLeft).Column
559 lastRow = sht.Cells(sht.Rows.Count, 5).End(xlUp).Row
560
561 For i = 2 To lastRow
562 sht.Cells(i, lastCol - 2).Value = Application.WorksheetFunction.Sum(sht.Range(sht.Cells(i, 8), sht.Cells(i, lastCol - 3))) - sht.Cells(i, 5)
563 Next i
564
565End Sub
566Sub CAO_Relocate_New()
567 Application.ScreenUpdating = False
568
569 Dim wbSource As Workbook, wbDest As Workbook, sht As Worksheet, sname As String, _
570 relPath As String, Srclstrow As Long, Dstlstrow As Long, lstrow As Long, fldrName As String, newbook As Workbook
571
572 Set wbSource = ActiveWorkbook
573
574 MkDir ("S:\Ryan Prince\CAO Reports POG\" & wbSource.Worksheets("Addtnl Strs Per Item").Range("A1").Value)
575
576 Set newbook = Workbooks.Add
577 Workbooks("Buyer Report Generator V6 (Working).xlsm").Worksheets("DNO").Copy before:=newbook.Sheets(1)
578 Application.DisplayAlerts = False
579 newbook.Sheets("Sheet1").Delete
580 Application.DisplayAlerts = True
581 Set wbDest = newbook
582
583 For Each sht In wbSource.Sheets
584 If sht.Name = "Group_PositionList" Or sht.Name = "Distribution" Or sht.Name = "Addtnl Strs Per Item" Then
585 Else
586 'Destination book
587 Srclstrow = sht.Cells(Rows.Count, 1).End(xlUp).Row
588 Dstlstrow = wbDest.Worksheets("DNO").Cells(Rows.Count, 1).End(xlUp).Row
589
590 sht.Range("A2:A" & Srclstrow).Copy wbDest.Worksheets("DNO").Range("C" & Dstlstrow)
591 sht.Range("B2:B" & Srclstrow).Copy wbDest.Worksheets("DNO").Range("A" & Dstlstrow)
592
593 Application.DisplayAlerts = False
594 sht.Delete
595 Application.DisplayAlerts = True
596 End If
597 Next
598
599 lstrow = wbDest.Worksheets("DNO").Cells(Rows.Count, 1).End(xlUp).Row
600
601 With wbDest.Worksheets("DNO")
602 .Range("C:C").ColumnWidth = 14
603 .Range("B2:B" & lstrow).Value = Date
604 .Range("E2:E" & lstrow).Value = Range("E2").Value
605 .Range("F2:F" & lstrow).Value = Range("F2").Value
606 .Range("H2:H" & lstrow).Value = Range("H2").Value
607 .Range("J2:J" & lstrow).Value = Range("J2").Value
608 .Range("L2:L" & lstrow).Value = Range("L2").Value
609 .Range("M2:M" & lstrow).Value = 0
610
611 End With
612
613 sname = wbDest.Worksheets("DNO").Cells(2, 1).Value & ".txt"
614 relPath = "S:\Ryan Prince\CAO Reports POG\" & wbSource.Worksheets("Addtnl Strs Per Item").Range("A1").Value & "\" & "DNO"
615
616 wbDest.SaveAs Filename:=relPath & sname, FileFormat:=xlTextWindows
617 wbDest.Close False
618
619End Sub
620Sub Multiply_By_Change()
621
622Dim e As Long, f As Long
623
624With Sheets("Addtnl Strs Per Item")
625 lastCol = .Cells(2, Columns.Count).End(xlToLeft).Column
626 lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
627 chng = .Cells(3, lastCol - 3).Column
628
629 For e = 3 To lastRow
630 For f = lastCol To lastCol
631 If Cells(e, lastCol).Value > 0 Then
632 Cells(e, lastCol).Value = .Cells(e, lastCol).Value * Cells(e, chng).Value
633 End If
634 Next
635 If Round(Cells(e, lastCol)) < .Cells(e, chng) Then
636 .Cells(e, chng).Interior.ColorIndex = 43
637 .Cells(e, lastCol).Interior.ColorIndex = 46
638 End If
639 Next e
640
641.Cells(1, lastCol).ColumnWidth = 11.25
642.Range(Cells(2, lastCol), Cells(lastRow, lastCol)).Interior.ColorIndex = 43
643.Range(Cells(2, lastCol), Cells(lastRow, lastCol)).EntireColumn.NumberFormat = "0"
644.Cells(2, lastCol).Value = "Est Reset Inv"
645
646End With
647
648End Sub