Semi-Complicated Question...

J

JohnNiman

At least for me. 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 Originals 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. Thank you, so much, in advance
for your help :)


Sub Everything_So_Far()

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:")

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

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

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
 

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

Top