Copying Data Down the Column But Only Based on What's in Column A

C

childofthe1980s

Hello:

I have four columns in an Excel spreadsheet. Column A ("Item Number") is a
list of inventory items. Column B ("Location Code") is to contain the phrase
"CH" in each cell of column B. Column C ("Order Point Qty") contains
quantities in each cell of column C. Column D ("Number of Days") contains
the number "10" in each cell of column D.

At the end of this posting is VBA code for a macro in Excel's Visual Basic
Editor that I am using to essentially create this spreadsheet. I am having
trouble with the following lines of code:

Range("B2:B" & Cells(Cells.Rows.Count, "A").End(xlUp).Row).FormulaR1C1 = "CH"
Range("C262:C" & Cells(Cells.Rows.Count, "A").End(xlUp).Row).FormulaR1C1
= "0"
Range("D2:D" & Cells(Cells.Rows.Count, "A").End(xlUp).Row).FormulaR1C1 =
"10"

You see, what I'm trying to accomplish is the following:

(1) Place "CH" in each cell of column B but only for as many cells as what
is filled in column A (i.e. only for as many cells as there are inventory
items in column A) and to do so only from B2 onward,
(2) Place the number "0" in cell C262 and in each succeeding cell of column
C afterward but again only for as many cells as what is filled in column A
(i.e. only for as many cells as there are inventory items in column A), and
(3) Place the number "10" in each cell of column D but only for as many
cells as what is filled in column A (i.e. only for as many cells as there are
inventory items in column A) and to do so only from D2 onward.

I thought that the three lines of code that I just mentioned woudld
accomplish this, but they did not.

Also. at the end of the code that i have attached I placed code to delete
Sheet1 of the workbook, but the macro did not do so. Why is that and how can
I fix it?

Finally, in other columns of the spreadsheet, I have done such things as
create formulas and place numeric cell formats. Similar to what I am trying
to do for the three columns that I mentioned a little while ago, what formula
do I use to say "hey, only do this for as many inventory items as what are in
column A?

Code follows:
ActiveWindow.LargeScroll ToRight:=1
ActiveWindow.SmallScroll ToRight:=-5
Range("L2:L" & Cells(Cells.Rows.Count, "J").End(xlUp).Row).FormulaR1C1 =
"=IF(RC[-2]<RC[-5], RC[-2]/RC[-5], 0)"
Columns("L:L").NumberFormat = "0%"
Range("L2:L" & Cells(Cells.Rows.Count, "J").End(xlUp).Row).Value =
Range("L2:L" & Cells(Cells.Rows.Count, "J").End(xlUp).Row).Value
Range("L1").Value = "% Below Min"
Application.CutCopyMode = False
Columns("L:L").EntireColumn.AutoFit
ActiveWindow.LargeScroll ToRight:=-1
Range("A1").Select
Selection.Subtotal GroupBy:=1, Function:=xlAverage, TotalList:=Array(4,
5, _
6, 7, 8, 9, 10, 11, 12), Replace:=True, PageBreaks:=False,
SummaryBelowData:= _
True
ActiveSheet.Outline.ShowLevels RowLevels:=2
Cells.Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Sheet2").Select
Cells.Select
ActiveSheet.Paste
Selection.Columns.AutoFit
Range("A1").Select
Application.CutCopyMode = False
Range("A1:L632").Sort Key1:=Range("D2"), Order1:=xlDescending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Columns("H:H").Select
Selection.Insert Shift:=xlToRight
Range("H2").Select
ActiveCell.FormulaR1C1 = "=RC[-1]*2"
Range("H2").Select
Selection.Copy
Columns("H:H").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.NumberFormat = "0"
Range("H1").Select
ActiveCell.FormulaR1C1 = "Order Point Qty"
Columns("B:G").Select
Selection.Delete Shift:=xlToLeft
Columns("C:G").Select
Selection.Delete Shift:=xlToLeft
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Range("B2").Select
ActiveCell.FormulaR1C1 = "'=LEFT(A2,LEN(A2)-8)"
Range("B2").Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[-1],LEN(RC[-1])-8)"
Range("B2").Select
Selection.Copy
Columns("B:B").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
Selection.Cut
Range("B1").Select
ActiveSheet.Paste
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
Range("B1").Select
ActiveCell.FormulaR1C1 = "Location Code"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Number of Days"
Range("D1").Select
Columns("D:D").ColumnWidth = 15
Range("B2:B" & Cells(Cells.Rows.Count, "A").End(xlUp).Row).FormulaR1C1 =
"CH"
Range("C262:C" & Cells(Cells.Rows.Count, "A").End(xlUp).Row).FormulaR1C1
= "0"
Range("D2:D" & Cells(Cells.Rows.Count, "A").End(xlUp).Row).FormulaR1C1 =
"10"
Sheets("Sheet1").Select
ActiveWindow.SelectedSheets.Delete
Range("A1").Select
End Sub
 
J

joel

I re-wrote a lot of your recorded macro code. the are things tha
didn't make a lot of sense. It looks like you add column H then end u
delting this column.

To delte sheet 1 simply do this

Sheets("Sheet1").Delete



Isn't this much simplier to understand.

LastRow = Range("A" & Rows.count).End(xlup).row
Range("B2:B" & LastRow) = "CH"
Range("C262:C" & LastRow) = "0"
Range("D2:D" & LastRow) = "10"




With Sheets("sheet1")
LastRow = .Range("J", Rows.Count).End(xlUp).Row
.Range("L2:L" & LastRow).FormulaR1C1 = _
"=IF(RC[-2]<RC[-5], RC[-2]/RC[-5], 0)"

.Columns("L:L").NumberFormat = "0%"
'I commented out this line because it copies the same data back t
the same cell
'.Range("L2:L" & LastRow).Value = _
' .Range("L2:L" & Lastrow).Value

.Range("L1").Value = "% Below Min"

.Columns("L:L").EntireColumn.AutoFit
.Range("A1").Subtotal _
GroupBy:=1, _
Function:=xlAverage, _
TotalList:=Array(4, 5, 6, 7, 8, 9, 10, 11, 12), _
Replace:=True, _
PageBreaks:=False, _
SummaryBelowData:=True

.Outline.ShowLevels RowLevels:=2

Set visibleCells = Cells.SpecialCells(xlCellTypeVisible)
visibleCells.Copy _
Destination:=Sheets("Sheet2").Cells
End With

With Sheets("sheet2")

.Cells.Columns.AutoFit
LastRow = .Range("A" & Rows.Count).End(xlUp).Row

.Range("A1:L" & LastRow).Sort _
Key1:=.Range("D2"), _
Order1:=xlDescending, _
Header:=xlGuess, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

.Columns("H:H").Insert
.Range("H2") = "=RC[-1]*2"
.Range("H2").Copy _
Destination:=.Range("H2:H" & LastRow)

.Range("H2:H" & LastRow).Copy
.Range("H2").PasteSpecial _
Paste:=xlPasteValues
.Columns("H:H").NumberFormat = "0"

.Range("H1") = "Order Point Qty"

.Columns("B:G").Delete

'What are you doing! this will delte column H htat was added above
.Columns("C:G").Delete

.Columns("B:C").Insert

'this formula is is beijng over-written by the next line
'.Range("B2").FormulaR1C1 = "'=LEFT(A2,LEN(A2)-8)"
.Range("B2").FormulaR1C1 = "=LEFT(RC[-1],LEN(RC[-1])-8)"


.Range("B2").Copy _
Destination:=.Range("H2:H" & LastRow)

.Range("B2:B" & LastRow).Copy
.Range("B2").PasteSpecial _
Paste:=xlPasteValues

.Range("A1").Cut
.Range("B1").Paste

.Columns("A:A").Delete

.Range("B1").FormulaR1C1 = "Location Code"
.Range("D1").FormulaR1C1 = "Number of Days"

.Columns("D:D").ColumnWidth = 15
.Range("B2:B" & LastRow) = "CH"

.Range("C262:C" & LastRow) = "0"
.Range("D2:D" & LastRow) = "10"
End Wit
 
C

childofthe1980s

This didn't work. All it did was put "CH" and "10" in the first two rows and
nothing in the other cells. Also, "0" was placed in rows 2 - 262. That's
the exact opposite of what I need.

FYI--There's no need to worry about what is happening "earlier" in the code
(i.e. deleting a column here, a column there). That's not my concern. I
simply want to know why I cannot place data in only as many rows as what is
in column A and how to do so.

childofthe1980s

joel said:
I re-wrote a lot of your recorded macro code. the are things that
didn't make a lot of sense. It looks like you add column H then end up
delting this column.

To delte sheet 1 simply do this

Sheets("Sheet1").Delete



Isn't this much simplier to understand.

LastRow = Range("A" & Rows.count).End(xlup).row
Range("B2:B" & LastRow) = "CH"
Range("C262:C" & LastRow) = "0"
Range("D2:D" & LastRow) = "10"




With Sheets("sheet1")
LastRow = .Range("J", Rows.Count).End(xlUp).Row
.Range("L2:L" & LastRow).FormulaR1C1 = _
"=IF(RC[-2]<RC[-5], RC[-2]/RC[-5], 0)"

.Columns("L:L").NumberFormat = "0%"
'I commented out this line because it copies the same data back to
the same cell
'.Range("L2:L" & LastRow).Value = _
' .Range("L2:L" & Lastrow).Value

.Range("L1").Value = "% Below Min"

.Columns("L:L").EntireColumn.AutoFit
.Range("A1").Subtotal _
GroupBy:=1, _
Function:=xlAverage, _
TotalList:=Array(4, 5, 6, 7, 8, 9, 10, 11, 12), _
Replace:=True, _
PageBreaks:=False, _
SummaryBelowData:=True

.Outline.ShowLevels RowLevels:=2

Set visibleCells = Cells.SpecialCells(xlCellTypeVisible)
visibleCells.Copy _
Destination:=Sheets("Sheet2").Cells
End With

With Sheets("sheet2")

.Cells.Columns.AutoFit
LastRow = .Range("A" & Rows.Count).End(xlUp).Row

.Range("A1:L" & LastRow).Sort _
Key1:=.Range("D2"), _
Order1:=xlDescending, _
Header:=xlGuess, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

.Columns("H:H").Insert
.Range("H2") = "=RC[-1]*2"
.Range("H2").Copy _
Destination:=.Range("H2:H" & LastRow)

.Range("H2:H" & LastRow).Copy
.Range("H2").PasteSpecial _
Paste:=xlPasteValues
.Columns("H:H").NumberFormat = "0"

.Range("H1") = "Order Point Qty"

.Columns("B:G").Delete

'What are you doing! this will delte column H htat was added above
.Columns("C:G").Delete

.Columns("B:C").Insert

'this formula is is beijng over-written by the next line
'.Range("B2").FormulaR1C1 = "'=LEFT(A2,LEN(A2)-8)"
.Range("B2").FormulaR1C1 = "=LEFT(RC[-1],LEN(RC[-1])-8)"


.Range("B2").Copy _
Destination:=.Range("H2:H" & LastRow)

.Range("B2:B" & LastRow).Copy
.Range("B2").PasteSpecial _
Paste:=xlPasteValues

.Range("A1").Cut
.Range("B1").Paste

.Columns("A:A").Delete

.Range("B1").FormulaR1C1 = "Location Code"
.Range("D1").FormulaR1C1 = "Number of Days"

.Columns("D:D").ColumnWidth = 15
.Range("B2:B" & LastRow) = "CH"

.Range("C262:C" & LastRow) = "0"
.Range("D2:D" & LastRow) = "10"
End With


--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread: http://www.thecodecage.com/forumz/showthread.php?t=164879

Microsoft Office Help

.
Click to expand...
 
J

joel

I found a couple of errors. these are the lines that I made changes t
to do what you want

LastRowB = .Range("B" & Rows.Count).End(xlUp).Row
Newrow = LastrowB + 1
.Range("B" & Newrow & ":B" & LastRow) = "CH"

You need to have two variables. One to indicate the end of Colun A an
One for the End of colunm B.

If you always want to start at row 3 then use this instead

.Range("B3:B" & LastRow) = "CH"




With Sheets("sheet1")
LastRow = .Range("J", Rows.Count).End(xlUp).Row
.Range("L2:L" & LastRow).FormulaR1C1 = _
"=IF(RC[-2]<RC[-5], RC[-2]/RC[-5], 0)"

.Columns("L:L").NumberFormat = "0%"
'I commented out this line because it copies the same data back to th
same cell
'.Range("L2:L" & LastRow).Value = _
' .Range("L2:L" & Lastrow).Value

.Range("L1").Value = "% Below Min"

.Columns("L:L").EntireColumn.AutoFit
.Range("A1").Subtotal _
GroupBy:=1, _
Function:=xlAverage, _
TotalList:=Array(4, 5, 6, 7, 8, 9, 10, 11, 12), _
Replace:=True, _
PageBreaks:=False, _
SummaryBelowData:=True

.Outline.ShowLevels RowLevels:=2

Set visibleCells = Cells.SpecialCells(xlCellTypeVisible)
visibleCells.Copy _
Destination:=Sheets("Sheet2").Cells
End With

With Sheets("sheet2")

.Cells.Columns.AutoFit
LastRow = .Range("A" & Rows.Count).End(xlUp).Row

.Range("A1:L" & LastRow).Sort _
Key1:=.Range("D2"), _
Order1:=xlDescending, _
Header:=xlGuess, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

.Columns("H:H").Insert
.Range("H2") = "=RC[-1]*2"
.Range("H2").Copy _
Destination:=.Range("H2:H" & LastRow)

.Range("H2:H" & LastRow).Copy
.Range("H2").PasteSpecial _
Paste:=xlPasteValues
.Columns("H:H").NumberFormat = "0"

.Range("H1") = "Order Point Qty"

.Columns("B:G").Delete

.Columns("C:G").Delete

.Columns("B:C").Insert

.Range("B2").FormulaR1C1 = "=LEFT(RC[-1],LEN(RC[-1])-8)"

.Range("B2").Copy _
Destination:=.Range("H2:H" & LastRow)

.Range("B2").Copy
.Range("B2").PasteSpecial _
Paste:=xlPasteValues

.Range("A1").Cut
.Range("B1").Paste

.Columns("A:A").Delete

.Range("B1").FormulaR1C1 = "Location Code"
.Range("D1").FormulaR1C1 = "Number of Days"

.Columns("D:D").ColumnWidth = 15


LastRowB = .Range("B" & Rows.Count).End(xlUp).Row
Newrow = LastrowB + 1
.Range("B" & Newrow & ":B" & LastRow) = "CH"

.Range("C2:C" & LastRow) = "0"
.Range("D2:D" & LastRow) = "10"
End Wit
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Different Results from the Same Macro 3
how to use Solver in Excel VBA 1
Advice on multiple macros, same code just a different column 9
works in 2007 but not in 2010 0
Copy row info but not in normal column sequence 6
Eliminate blanks while copy row and transpose 11
variable number of rows. 3
Cleanup this macro please 3

Top