I'm trying to work on a macro that does several
things, and I've hit a stumbling block. Of course, I didn't know the
first thing about VBA yesterday, so I think my learning curve has
been okay.
Here's what the macro needs to do:
Find a Range of cells in one workbook (In this case Sold-KBH001-
01.xls). This range will not always be the same, and can begin and
end on different cells each time. Bonus points if this can work in
any sheet and not just this one.
Select columns B,C,D,F,G,O of this range.
Copy them into columns K,L,M,N,P,R of a different work book (these
rows will always start at A-2 in this work book, but will end in
different places and I need to be able to copy one blank row and
insert as many new rows as there were lines in the selected range
above to retain the formulas.) This new workbook is (and can always
be) named P0020 Purchase Order Master.xls.
I then need to sort the new range by column K and check for
duplicate entries. If there is a duplicate entry that matched
Manufacturer Number (Column K) Model (Column L) and Price (Column P)
then I need to add the duplicate's quantity (Column N) to the
Original's quantity and delete the duplicate line.
Finally, I need the workbook to auto save as a new book.
Here is the code that I've written so far. It's been hacked together
from bits and pieces I can gather from a college text book and
internet searches, so I'm sure it's not pretty. I've gotten through
most everything except the checking for duplicates portion though.
Thank you, so much, in advance for your help.
Sub Everything_So_Far()
`This code asks the user where the cell range begins and ends.
Dim FirstNumber As String
Dim SecondNumber As String
Dim intLoopIndex As Integer
Dim intMaximum As Integer
intMaximum = 150
FirstNumber = InputBox("Enter the cell where the data begins:")
SecondNumber = InputBox("Enter the cell where the data ends:")
`This copys and pastes the selected range into a new sheet and
`deletes unneccessary columns
Range(FirstNumber, SecondNumber).Select
Selection.Copy
Sheets.Add
ActiveSheet.Paste
Sheets("Assumptions").Select
Sheets.Add
ActiveSheet.Paste
Columns("B:B").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Columns("C:C").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Columns("D:D").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Columns("F:F").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Columns("G:G").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Columns("O:O").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A:A,E:E,H:N,P:Z").Select
Range("H1").Activate
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("A:A,E:E,H:N,P:Z").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Range("A:A,E:E,H:N,P:Z").EntireColumn.AutoFit
Columns("F:F").EntireColumn.AutoFit
`This code inserts 300 rows of copied cells (the most I can envision
`needing), pastes the collumns from the created sheet into the sheet
`I want them in, and then deletes all unused rows.
For intLoopIndex = 0 To intMaximum
Windows("P0020 Purchase Order Master.xls").Activate
Rows("3:4").Select
Selection.Copy
Selection.Insert Shift:=xlDown
Next intLoopIndex
Range("K2").Select
Windows("SOLD-KBH001-01.xls").Activate
Range("A1:A300").Select
Application.CutCopyMode = False
Selection.Copy
Windows("P0020 Purchase Order Master.xls").Activate
ActiveSheet.Paste
Range("L2").Select
Range("L2").Select
Windows("SOLD-KBH001-01.xls").Activate
Range("B1:B300").Select
Application.CutCopyMode = False
Selection.Copy
Windows("P0020 Purchase Order Master.xls").Activate
ActiveSheet.Paste
Range("M2").Select
Range("M2").Select
Windows("SOLD-KBH001-01.xls").Activate
Range("C1:C300").Select
Application.CutCopyMode = False
Selection.Copy
Windows("P0020 Purchase Order Master.xls").Activate
ActiveSheet.Paste
Range("N2").Select
Range("N2").Select
Windows("SOLD-KBH001-01.xls").Activate
Range("D1:D300").Select
Application.CutCopyMode = False
Selection.Copy
Windows("P0020 Purchase Order Master.xls").Activate
ActiveSheet.Paste
Range("P2").Select
Range("P2").Select
Windows("SOLD-KBH001-01.xls").Activate
Range("E1:E300").Select
Application.CutCopyMode = False
Selection.Copy
Windows("P0020 Purchase Order Master.xls").Activate
ActiveSheet.Paste
Range("R2").Select
Range("R2").Select
Windows("SOLD-KBH001-01.xls").Activate
Range("F1:F300").Select
Application.CutCopyMode = False
Selection.Copy
Windows("P0020 Purchase Order Master.xls").Activate
ActiveSheet.Paste
Range("A1").Select
Columns("K:K").EntireColumn.AutoFit
Columns("L:L").EntireColumn.AutoFit
Columns("M:M").EntireColumn.AutoFit
Columns("N:N").EntireColumn.AutoFit
Columns("P:P").EntireColumn.AutoFit
Columns("Q:Q").EntireColumn.AutoFit
Columns("R:R").EntireColumn.AutoFit
Windows("SOLD-KBH001-01.xls").Activate
Sheets("Sheet1").Select
Application.CutCopyMode = False
ActiveWindow.SelectedSheets.Delete
Sheets("Sheet2").Select
ActiveWindow.SelectedSheets.Delete
Windows("P0020 Purchase Order Master.xls").Activate
Range("K2", "K308").Select
On Error Resume Next
Selection.SpecialCells(xlCellTypeBlanks).EntireRow .Delete
ActiveSheet.UsedRange
`The remainder of the code is me trying to figure out how to find
`duplicates and handle all the manipulation that needs to be done
`with them.
Dim StartingMan As String
Dim NextMan As String
Dim StartingModel As String
Dim NextModel As String
Dim StartingPrice As Currency
Dim NextPrice As Currency
Dim Hold As Variant
Dim StartingQuantity
Dim NewQuantity
StartingMan = Range("k2")
StartingModel = Range("L2")
StartingPrice = Range("P2")
Hold = 0
If StartingMan = NextMan And StartingModel = NextModel And
StartingPrice = NextPrice Then
End Sub