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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Complicated Sort-Compare-Delete Question
OK I'll have a go. The macro below addresses only the deletion of duplicate
rows once all the copying, pasting etc has been done by your code. I have assumed that column T is blank. Save your data before trying this - no undo afterwards. Sub DelThem() Dim lRow As Long Dim tCode As String Dim fCode As String Dim colK As Range Dim chk As Range Dim l As Long Dim counter As Long On Error GoTo ErrorHandler Application.ScreenUpdating = False 'find last row lRow = Cells(Rows.Count, 11).End(xlUp).Row 'set range = all data in column K Set colK = Range(Cells(2, 11), Cells(lRow, 11)) 'loop through column K For Each chk In colK 'if column T already populated then do nothing If chk.Offset(0, 9).Value = Empty Then 'if column T not populated then mark to keep row chk.Offset(0, 9).Value = "keep" 'Set variable tCode = Man Code + Model + Price tCode = chk.Value & chk.Offset(0, 1).Value & _ chk.Offset(0, 5).Value 'Check rest of data to bottom For l = chk.Row + 1 To lRow 'set variable fCode = Man Code + Model + Price fCode = Cells(l, 11).Value & Cells(l, 12).Value & _ Cells(l, 16).Value 'if Man Code + Model + Price equal then... If fCode = tCode Then 'add qty from this row to row being checked chk.Offset(0, 3).Value = chk.Offset(0, 3).Value + _ Cells(l, 14).Value 'mark row for deletion Cells(l, 20).Value = "delete" End If 'compare next row to row being checked Next l End If 'check next row Next chk 'start at bottom and delete all rows marked for deletion For counter = l To 2 Step -1 If Cells(counter, 20).Value = "delete" Then Cells(counter, 20).EntireRow.Delete End If Next counter 'clear contents of column T Columns(20).ClearContents ErrorHandler: Application.ScreenUpdating = True End Sub I haven't really looked at the rest of your code in detail but it could use a bit of cleaning up. Remember you don't have to select cells in order to perform an operation on them so for example: 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 could be rewritten as With Range("B:D") .Value = .Value End With Hope this helps Rowan PS you could adapt this to do your file saving. Allows the user to chose folder and filename Sub SaveIt() Dim fFilter As String Dim flName As Variant fFilter = "Excel Files (*.xls), *.xls" flName = Application.GetSaveAsFilename(, fFilter) If flName = False Then Exit Sub Else ThisWorkbook.SaveAs Filename:=flName, _ FileFormat:=xlWorkbookNormal End If End Sub "JohnTNiman - ExcelForums.com" wrote: 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 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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Complicated Sort-Compare-Delete Question
Rowan, THANK YOU! :) It works *almost* perfectly. I think that the comparison formula i missing something though. If, for instance, I have three items, all o which have the same model number, description and quantity ordered, bu for some reason one of the prices is different, they are all combine under one heading with quantity of three, as opposed to two heading with quantities on 2 and 1. Did that make sense? Any thoughts on how to add that? On a side note, I know my code is horribly sloppy. I've got the basic of VBA down, but this has been chopped together from recording an manipulating what I want and looking for examples on the internet Someone who really knew what they were doing could probably cut 10 lines out ;) Thank you again, I appreciate the help a lot -- JohnNima ----------------------------------------------------------------------- JohnNiman's Profile: http://www.excelforum.com/member.php...fo&userid=2536 View this thread: http://www.excelforum.com/showthread.php?threadid=39077 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Complicated Sort-Compare-Delete Question
Hi John
I am not sure I have completely understood your question. The way it is currently working is to check the Manufacturer in column K, the model in Column L and the Price in column P. It these are all the same then the quantities in column N are added together and the extra line is deleted. So if you had 3 records with a qty of 1 each and the same manufacturer, model and price you will be left with one record with a qty of 3. That is how it is currently working for me. If one of the prices is different then you should be left with two records one with a qty of 2 and the other with 1. It should do that currently. Is this what you are after or do you want all three of those records added together? If this is the case, which price would you keep? Regards Rowan "JohnNiman" wrote: Rowan, THANK YOU! :) It works *almost* perfectly. I think that the comparison formula is missing something though. If, for instance, I have three items, all of which have the same model number, description and quantity ordered, but for some reason one of the prices is different, they are all combined under one heading with quantity of three, as opposed to two headings with quantities on 2 and 1. Did that make sense? Any thoughts on how to add that? On a side note, I know my code is horribly sloppy. I've got the basics of VBA down, but this has been chopped together from recording and manipulating what I want and looking for examples on the internet. Someone who really knew what they were doing could probably cut 100 lines out ;) Thank you again, I appreciate the help a lot. -- JohnNiman ------------------------------------------------------------------------ JohnNiman's Profile: http://www.excelforum.com/member.php...o&userid=25366 View this thread: http://www.excelforum.com/showthread...hreadid=390774 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Complicated Sort-Compare-Delete Question
Hi John
I am going to be offline from now until Monday morning Australian Eastern Standard Time. I'll check back then Regards Rowan "Rowan" wrote: Hi John I am not sure I have completely understood your question. The way it is currently working is to check the Manufacturer in column K, the model in Column L and the Price in column P. It these are all the same then the quantities in column N are added together and the extra line is deleted. So if you had 3 records with a qty of 1 each and the same manufacturer, model and price you will be left with one record with a qty of 3. That is how it is currently working for me. If one of the prices is different then you should be left with two records one with a qty of 2 and the other with 1. It should do that currently. Is this what you are after or do you want all three of those records added together? If this is the case, which price would you keep? Regards Rowan "JohnNiman" wrote: Rowan, THANK YOU! :) It works *almost* perfectly. I think that the comparison formula is missing something though. If, for instance, I have three items, all of which have the same model number, description and quantity ordered, but for some reason one of the prices is different, they are all combined under one heading with quantity of three, as opposed to two headings with quantities on 2 and 1. Did that make sense? Any thoughts on how to add that? On a side note, I know my code is horribly sloppy. I've got the basics of VBA down, but this has been chopped together from recording and manipulating what I want and looking for examples on the internet. Someone who really knew what they were doing could probably cut 100 lines out ;) Thank you again, I appreciate the help a lot. -- JohnNiman ------------------------------------------------------------------------ JohnNiman's Profile: http://www.excelforum.com/member.php...o&userid=25366 View this thread: http://www.excelforum.com/showthread...hreadid=390774 |
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 sort function with sort and sum | Excel Worksheet Functions | |||
Complicated Sort-Compare-Delete Question | Excel Programming |