I need help creating a excel macro to split orders based on qty column.
In the before sheet we have 4 orders with two of them having a qty greater the 1. see before macro image
What I need is an excel macro that can check the qty field and insert new rows below based on qty value if greater then 1, then populate these rows with the data from the original row.
Then the last step would be to delete the C column. See After Macro image
I have never used macros before, so i'm not even sure if this can be done.
It's only 10 lines of code. SO is not a code sweatshop where we do the work for you, it is one where we help you work it out for yourself.
This will poll the rows for you going backwards:
For X = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
This is key because you will be inserting rows, going forwards creates all sort of nastiness.
You will then need a loop inside there using your qty as a reference. Here is one I built but you will need to make some changes for it to work for your columns:
For Y = 1 To Range("B" & X).Value - 1
Then you need to copy row X inside this loop
Next line will be an insert with a shift down (like this Insert Shift:=xlDown) on row X + 1 or on an offset of row X by 1 row, your choice how you do this.
Last thing to do is delete column C, This can be done like this Range("C1").EntireColumn.Delete
That is it, the whole macro, just drop a couple of nexts and an end sub and run it.
You will need to Dim X and Y, dim them as longs.
Have a go, if you get stuck post back with the code you have put together and we can help you fix it.
Related
I am a beginner in VBA.
I have components which always consist from 2 parts. (Rotor and a stator, each has its own number). When work is with them it can be damaging some of these parts, however it is necessary to keep a list of damaged parts, where the result is inventory e.g. 200 rotors, stators 150 with different numbers. Before I could scrap it, I need to complete them as proper sets. I.e. rotor "a" stator "a", "b" with "b", etc. It's crazy to work with many numbers to compare them, copy …to find the result of sets qty.
It is possible to solve it with Macro, what I try to do, but I was stuck.
What is the task: In the column "A" I have a list of all damaged parts (mix of rotors, stators different numbers). In the column "C" an information only with help of VlookUP, what should be a counterpart number.
What do I need to solve: In row 5, column. „A“ I have component number , but I know that in the same column, somewhere from row 6 to xx I have a counterpart. What I need is … according to information from column C, same row(5) where is info about the counterpart num. to find counerpart in column A, when found, took it out and put into cell B5. Thus,I get a complete set. Then the next row (6), same action. Macro reading num. in „C“,searching in „A“, when found, cut, and put to „B“ next row 7,8,9,… The result should be a certain qty of pairs + some single numbers if not second part found.
The problem I have is that cycle is working until always found relared counterpart. If the counterpart in row A is not available (no match betwen C-A), the code will stop on that row.
What I need help with is, that if code did not find the counerpart based to info from C just skip this row, make it red and continue with next row till end, it means stop on first empty cell in C. Thanks a lot to everybody who is helping me.
Dim pn As Range,
Dim a
Dim x
x = 5
Dim i As Long, Dim radek As Long
a = Cells(x, 3)
For i = 1 To 500
Range("A:A").Select
Set pn = Selection.Find(What:=a)
If Not pn Is Nothing Then
pn.Select
End If
Selection.Cut
Cells(x, 2).Select
ActiveSheet.Paste
x = x + 1
Next
End Sub
I am trying to write a VBA to draw data from one sheet to another, but am stuck on something.
I only need some of the data in the original sheet (let's call it s1), in particular, I need data between two rows.
I have these rows written down in another sheet (s2), so I know exactly between which rows I need the data from. As you may expect there are multiple rows between which I need the data.
The problem is now that I am trying to write a VBA that is able to look up these rows in my row sheet (s2), and then goes to the sheet in which all my original data is contained (s1), and then draws out the data between the two rows into a third sheet (s3).
I have not been able to make it draw in the numbers from s2 (can't seem to work out how to tell it that it is these two rows between which I need the data, but from another sheet), and currently have to input the row numbers myself, which is really tedious, since the dataset is large!
Any help would be much appreciated!
Thank you!
Have you tried the .find option.
You could use something like this:
findrow = w1.Cells.Find(what:="Content", MatchCase:=False).Row
An more extensive example would help
Just break down your problem into smaller steps.
You can assign a value on a sheet using cell references:
Sheets("S1").Cells(iRow, iCol) = Value
'or
Sheets("S3").Cells(2, 10) = Sheets("S2").Cells(2, 10)
You can use Sheets("S1").Range("J" & iRow) or Range("J2").
If there are conditions that need to be met for something to happen, use If statements.
If (Value 1 < Value 2) Then
Sheets("S3").Cells(2, 10) = Sheets("S2").Cells(2, 10)
Else
Sheets("S3").Cells(2, 10) = Sheets("S1").Cells(2, 10)
End If
Without more information about the specific choices you are using to determine which rows to copy and from which sheet, it's hard to say. But you can do things in smaller batches or copy whole ranges, by looping.
Dim iRow As Integer
'This would copy all the data from Sheet("S1").Range("J1:J20) to Sheet "S3".
For iRow = 1 to 20
Sheets("S3").Cells(iRow, 10) = Sheets("S1").Cells(iRow, 10)
Next iRow
You could insert an If statement into each row, inside the loop to see if a certain criteria is met, and then decide which sheet in which to copy the data.
My Goal: To get all data about the same subject from multiple reports (already in the same spreadsheet) in the same row.
Rambling Backstory: Every month I get a new datadump Excel spreadsheet with several reports of variable lengths side-by-side (across columns). Most of these reports have overlapping subjects, but not entirely. Fortunately, when they are talking about the same subject, it is noted by a number. This number tag is always the first column at the beginning of each report. However, because of the variable lengths of reports, the same subjects are not in the same rows. The columns with the numbers never shift (report1's numbers are always column A, report2's are always column G, etc) and numbers are always in ascending order.
My Goal Solution: Since the columns with the ascending numbers do not change, I've been trying to write VBA code for a Macro that compares (for example) the number of the active datarow with from column A with Column G. If the number is the same, do nothing, else move all the data in that row (and under it) from columns G:J down a line. Then move on to the next datarow.
I've tried: I've written several "For Each"s and a few loops with DataRow + 1 to and calling what I thought would make the comparisons, but they've all failed miserably. I can't tell if I'm just getting the syntax wrong or its a faulty concept. Also, none of my searches have turned up this problem or even parts of it I can maraud and cobble together. Although that may be more of a reflection of my googling skill :)
Any and all help would be appreciated!
Note: In case it's important, the columns have headers. I've just been using DataRow = Found.Row + 1 to circumvent. Additionally, I'm very new at this and self-taught, so please feel free to explain in great detail
I think I understand your objective and this should work. It doesn't use any of the methodology you were using as reading your explanation I had a good idea how to proceed. If it isn't what you are looking for my apologies.
It starts at a predefined column (see FIRST_ROW constant) and goes row by row comparing the two cells (MAIN_COLUMN & CHILD_COLUMN). If MAIN_COLUMN < CHILD_COLUMN it pushes everything between SHIFT_START & SHIFT_END down one row. It continues until it hits an empty row.
Sub AlignData()
Const FIRST_ROW As Long = 2 ' So you can skip a header row, or multiple rows
Const MAIN_COLUMN As Long = 1 ' this is your primary ID field
Const CHILD_COLUMN As Long = 7 ' this is your alternate ID field (the one we want to push down)
Const SHIFT_START As String = "G" ' the first column to push
Const SHIFT_END As String = "O" ' the last column to push
Dim row As Long
row = FIRST_ROW
Dim xs As Worksheet
Set xs = ActiveSheet
Dim im_done As Boolean
im_done = False
Do Until im_done
If WorksheetFunction.CountA(xs.Rows(row)) = 0 Then
im_done = True
Else
If xs.Cells(row, MAIN_COLUMN).Value < xs.Cells(row, CHILD_COLUMN).Value Then
xs.Range(Cells(row, SHIFT_START), Cells(row, SHIFT_END)).Insert Shift:=xlDown
Debug.Print "Pushed row: " & row & " down!"
End If
row = row + 1
End If
Loop
End Sub
I modified the code to work as a macro. You should be able to create it right from the macro dialog and run it from there also. Just paste the code right in and make sure the Sub and End Sub lines don't get duplicated. It no longer accepts a worksheet name but instead runs against the currently active worksheet.
I'm looking for an algorithm for which I do not have the VBA knowledge to script myself. So I'm stuck. It isn't through lack of effort trying because I have given it a go (plus, this bit of code is the last remaining piece of my bigger VBA code) I simply lack the knowledge/experience/skill...
Basically, I have an Excel file. In this file is a sheet, "sheet1". Sheet1 contains many rows of data. The number of rows contained in sheet1 can vary from 1 to n. Sometimes, I may have 50 while other times I may have 30, etc. What is consistent is the layout of the book, i.e. I have codes in column A which identify a product in my database.
What I want to do is this:
1. Scan the sheet for empty rows (due to the way the workbook is generated, I sometimes have blank rows) and remove them. These blank rows are sometimes in-between rows with data while at other times may be trailing at the end of the sheet.
2. After removing the blank rows find the last used row. Store that to a variable. I have found this piece of code useful for doing that:
mylastrow = myBook.Sheets("Results").Cells.Find(what:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
3. Starting from the row determined in (2), I want to take the product code in A(x where x = mylastrow) and find any other occurrences of it (in column A). If any are found, delete that entire row corresponding to it. Importantly, this loop must go in reverse. For example let's say mylastrow = 40, the loop will need to begin at A40 and on the next iteration do A39 (or 38 if a row has been removed?). This is because with any of the product numbers the corresponding data in the row contains more data further down the column (because of the way the sheet was generated). Essentially the entry closest to the last row is the most recent.
Hopefully I've been able to explain the situ properly. But if not and you're willing to take the challenge (my burden?) off me I would be very grateful.
QF
The only way to develop that knowledge and skill is to get in there and code! I'm sure someone may come in and write you the entire procedure, but in the meantime these resources should give you the tools to do it yourself.
First, check out the method here to delete blank rows. It relies on "Selection" for the range, so you can either manually select all the cells of the sheet, then run the macro, or replace it with the following:
Dim r as range
set r = Sheet1.Cells 'now use r instead of Selection
OR (even better) use your code for finding the last used row and set the range from row 1 to "mylastrow".
Next, beginning from "mylastrow", start adding the values in Column A to a Dictionary object (example here). You can use a row counter to decrement from "mylastrow" to 1. Here's an example of how it would work. The key is assumed to be in the 1st column ("A").
Dim dict As Object
Dim rowCount As Long
Dim strVal As String
Set dict = CreateObject("Scripting.Dictionary")
rowCount = Sheet1.Range("A1").CurrentRegion.Rows.Count
Do While rowCount > 1
strVal = Sheet1.Cells(rowCount, 1).Value2
If dict.exists(strVal) Then
Sheet1.Rows(rowCount).EntireRow.Delete
Else
dict.Add strVal, 0
End If
rowCount = rowCount - 1
Loop
Set dict = Nothing
Before:
After:
Note that the 1st row hasn't been touched since we stopped when rowCount is 1 (assumes there's a header).
I've got a table in a word document which I'm trying to add a row to. This additional row needs to be the same as the first row in the table which serves as a template.
Let's assume my table has exactly one row to begin with. I would now like to add a new row with the same specifications, then merge all 3 columns. Under that I would like to add an additional row, but with 3 columns again like the first row.
What I tried:
Dim oTemplateRow As Word.Row
Set oTemplateRow = oTable.Rows(1)
oTemplateRow.Range.Copy
' adds a row like the template one
oTable.Rows.Last.Range.Paste
So far, so good. But if I now merge the cells in that line and then repeat the paste, the new line appears before the previously added one, even with a collapse of the range before - this is what I do not understand.
oTable.Rows.Last.Cells.Merge
oTable.Rows.Last.Range.Collapse Direction:=wdCollapseEnd
oTable.Rows.Last.Range.Paste
oTable.Rows.Last.Range.Collapse Direction:=wdCollapseEnd
Any help would be greatly appreciated.
It appears that I am now able to answer my own question. Although it may not be the most elegant solution, it solves my problem. I have simply used
oTable.Rows.Add
after the initial row had been created, therefore creating an exact copy underneath. When I need to add a row, I repeat that process and keep working on the one previous to the last one.
Private Function addRow(ByRef oRow As Word.Row, Optional iNumberColumns As Integer = 3)
' add a row to the end, then work on the one before that
oTable.Rows.Add
Set oRow = oTable.Rows(oTable.Rows.Count - 1)
' if number of columns is 1 merge 2 to 4, if 2 merge 3 to 4
Select Case iNumberColumns
Case 1
oRow.Cells(2).Merge MergeTo:=oRow.Cells(4)
Case 2
oRow.Cells(3).Merge MergeTo:=oRow.Cells(4)
End Select
End Function
May be a bit longwinded, but works for me.
Regards
Stefan