Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Complicated Sort-Compare-Delete Question
At least for me. I'm trying to work on a macro that does severa
things, and I've hit a stumbling block. Of course, I didn't know th first thing about VBA yesterday, so I think my learning curve ha 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 an end on different cells each time. Bonus points if this can work i 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 (thes rows will always start at A-2 in this work book, but will end i different places and I need to be able to copy one blank row an insert as many new rows as there were lines in the selected rang above to retain the formulas.) This new workbook is (and can alway be) named P0020 Purchase Order Master.xls I then need to sort the new range by column K and check fo duplicate entries. If there is a duplicate entry that matche Manufacturer Number (Column K) Model (Column L) and Price (Column P then I need to add the duplicate's quantity (Column N) to th 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 togethe from bits and pieces I can gather from a college text book an internet searches, so I'm sure it's not pretty. I've gotten throug 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 Strin Dim SecondNumber As Strin Dim intLoopIndex As Intege Dim intMaximum As Intege intMaximum = 15 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 an `deletes unneccessary column Range(FirstNumber, SecondNumber).Selec Selection.Cop Sheets.Ad ActiveSheet.Past Sheets("Assumptions").Selec Sheets.Ad ActiveSheet.Past Columns("B:B").Selec Application.CutCopyMode = Fals Selection.Cop Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone SkipBlanks :=False, Transpose:=Fals Columns("C:C").Selec Application.CutCopyMode = Fals Selection.Cop Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone SkipBlanks :=False, Transpose:=Fals Columns("D:D").Selec Application.CutCopyMode = Fals Selection.Cop Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone SkipBlanks :=False, Transpose:=Fals Columns("F:F").Selec Application.CutCopyMode = Fals Selection.Cop Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone SkipBlanks :=False, Transpose:=Fals Columns("G:G").Selec Application.CutCopyMode = Fals Selection.Cop Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone SkipBlanks :=False, Transpose:=Fals Columns("O:O").Selec Application.CutCopyMode = Fals Selection.Cop Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone SkipBlanks :=False, Transpose:=Fals Range("A:A,E:E,H:N,P:Z").Selec Range("H1").Activat Application.CutCopyMode = Fals Selection.Delete Shift:=xlToLef Range("A:A,E:E,H:N,P:Z").EntireColumn.AutoFi Columns("B:B").EntireColumn.AutoFi Columns("C:C").EntireColumn.AutoFi Columns("D:D").EntireColumn.AutoFi Range("A:A,E:E,H:N,P:Z").EntireColumn.AutoFi Columns("F:F").EntireColumn.AutoFi `This code inserts 300 rows of copied cells (the most I can envisio `needing), pastes the collumns from the created sheet into the shee `I want them in, and then deletes all unused rows For intLoopIndex = 0 To intMaximu Windows("P0020 Purchase Order Master.xls").Activat Rows("3:4").Selec Selection.Cop Selection.Insert Shift:=xlDow Next intLoopInde Range("K2").Selec Windows("SOLD-KBH001-01.xls").Activat Range("A1:A300").Selec Application.CutCopyMode = Fals Selection.Cop Windows("P0020 Purchase Order Master.xls").Activat ActiveSheet.Past 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Complicated nested row formula - Multiple Range Compare | Excel Discussion (Misc queries) | |||
IF question complicated | Excel Discussion (Misc queries) | |||
Complicated Question | Excel Worksheet Functions | |||
Complicated question... | Excel Worksheet Functions | |||
Complicated sort function with sort and sum | Excel Worksheet Functions |