I am using Excel VBA for this project. The goal of the project is to have a worksheet that shows a number of columns. Each column is headed with an item code (for a scoop) and the quantity of the scoop in inventory. This part is created and functional.
I then want the workbook to search through the list of open orders, get the item id needed to create the product on the open order, and put it in the column of items previously created.
The following code is what I have so far
For j = 2 to 264
For p =2 to 300
'If the item on the order matches the item on the material required sheet, then the variables are set and it starts the inner loop
If Sheets("OOR").Cells(j, 5).Value = Sheets("BOM").Cells(p, 1).Value then
FgScoQty = Sheets("OOR").Cells(j, 10).Value
ItemScoop = Sheets("BOM").Cells(p, 4).Value
FgItem = Sheets("BOM").Cells(p, 1).Value
'If they match, it then looks on the sheet with the columns to put this information in the next blank row of the correct column
For x = 1 to 258
If ItemScoop = Sheets("Sheet5").Cells(1, x).Value Then
lastRow = Sheets("Sheets5").Cells(Rows.Count, x).End(xlUp).Offset(1, 0).Row
Sheets("Sheet5").Cells(lastRow, x).Value = fgItem
Sheets("Sheet5").Cells(lastRow, x).Offset(0, 1).Value = fgScoQty
End If
Next x
End If
Next p
Next j
This works the first time perfectly
After that I get an issue on the line
If ItemScoop = Sheets("Sheet5").Cells(1, x).Value Then
I am not sure why. I believe I need to exit the inner loop (loop x) after the condition has been met. I've done a lot of searching on the net since this seemed like a fairly common problem, but I cannot find anything that works.
When I try Exit For it seems to remove me from all my loops.
I want it to fill in the cells with the variables, and then return to the beginning and look at the next j.
You need to exit the loop once you achieve what you want
So to force the beginning of the next loop ( j ), you need to use the Exit for
Try it:
For j = 2 to 264
For p =2 to 300
'If the item on the order matches the item on the material required sheet, then the variables are set and it starts the inner loop
If Sheets("OOR").Cells(j, 5).Value = Sheets("BOM").Cells(p, 1).Value then
FgScoQty = Sheets("OOR").Cells(j, 10).Value
ItemScoop = Sheets("BOM").Cells(p, 4).Value
FgItem = Sheets("BOM").Cells(p, 1).Value
'If they match, it then looks on the sheet with the columns to put this information in the next blank row of the correct column
For x = 1 to 258
If ItemScoop = Sheets("Sheet5").Cells(1, x).Value Then
lastRow = Sheets("Sheets5").Cells(Rows.Count, x).End(xlUp).Offset(1, 0).Row
Sheets("Sheet5").Cells(lastRow, x).Value = fgItem
Sheets("Sheet5").Cells(lastRow, x).Offset(0, 1).Value = fgScoQty
End If
Next x
'HERE YOU ESCAPE THE LOOP
Exit For
Else
End If
Next p
Next j
Related
I'm having trouble with my loop not running throughout my entire sheet 1. If the value in Sheet 1 "tests" exist in sheet 2 "cancer". Then i want the value in sheet 2 "cancer" to be placed into sheet 1 "Tests". The code works except for the loop. Currently it only applies to the first record in my first sheet then stops.
Sub Testing()
Dim x As Long
Dim y As Long
x = 2
y = 2
Do While Sheets("Cancer").Cells(y, 1).Value <> ""
If LCase(Trim(Sheets("Cancer").Cells(y, 1).Text)) = LCase(Trim(Sheets("Tests").Cells(x, 3).Text)) Then
If Sheets("Tests").Cells(x, 4).Value = "" Then
Cells(x, 4) = (Trim(Sheets("Cancer").Cells(y, 3).Text))
x = x + 1
End If
End If
y = y + 1
Loop
End Sub
I would use two for loops
for y = 2 to 10000 'the range your values are found
if Sheets("Cancer").Cells(y, 1).Value <> "" then
for x = 2 to 10000 'the range your values are in
If LCase(Trim(Sheets("Cancer").Cells(y, 1).Text)) = LCase(Trim(Sheets("Tests").Cells(x, 3).Text)) and Sheets("Tests").Cells(x, 4).Value = "" Then
Cells(x, 4) = (Trim(Sheets("Cancer").Cells(y, 3).Text))
End If
next
end if
next
The reason for the loop not running throughout the entire sheet 1 is because of these two lines:
If LCase(Trim(Sheets("Cancer").Cells(y, 1).Text)) = LCase(Trim(Sheets("Tests").Cells(x, 3).Text)) and Sheets("Tests").Cells(x, 4).Value = ""
If these conditionals aren't both true, then x will never loop to its next iteration, and you'll have gone through looping through each value of Sheet2 "Cancer" while checking only the same record of Sheet1 "Tests".
You've almost qualified all of your ranges. You missed one. Try changing the line:
Cells(x, 4) = (Trim(Sheets("Cancer").Cells(y, 3).Text))
to
Sheets("Tests").Cells(x, 4) = (Trim(Sheets("Cancer").Cells(y, 3).Text))
I have an Excel Table, with some columns. But at the moment a have a problem with column Duration.
When I scrolled down the table, i have unexpectedly noticed, that many IDs have empty lines, and only one line of this ID has an actual value.
Is it possible to fill up other empthy lines with this only one existing value using VBA? That means, that all empty values for ID6979960 should be filled up with a value 42:15:56, and so on.
Without that, my other calculations in my table, don't work properly.
I don't know exactly how copying of values works in VBA.
Public Sub FillEmpty()
Dim finded As Range
Dim Sheet As Worksheet
Set Sheet = ActiveSheet 'or any other sheet -> .Sheets("")
With Sheet
lastrow = .Cells(1, 1).End(xlDown).Row
For i = 1 To lastrow
If StrComp(.Cells(i, 2).Value, "") = 0 Then
Set finded = .Columns(2).Find("*", after:=.Cells(i, 2), LookIn:=xlValues)
ID = .Cells(finded.Row, 1).Value
Filler = .Cells(finded.Row, 2).Text
Else
ID = .Cells(i, 1).Value
Filler = .Cells(i, 2).Text
End If
Index = i
While ID = .Cells(Index, 1).Value
.Cells(Index, 2).Value = Filler
Index = Index + 1
Wend
Next i
End With
End Sub
Made it real quick so not the most optimal solution. I tested it with your example and it works. Not sure with many more rows. Check it and let me know if it works for you.
Sub fillerv2()
rowscnt = 1000
tmi = 1
tm = ""
For i = 1 To rowscnt
If tm <> Cells(i, 1).Value Then
For o = tmi To i - 1
If IsEmpty(Cells(o, 2).Value) = False Then
Pattern = Cells(o, 2).Value
Exit For
End If
Next o
For o = tmi To i - 1
Cells(o, 2).Value = Pattern
Next o
tm = Cells(i, 1).Value
tmi = i
End If
Next i
I am copying data from one sheet to another, from source range(Q5:AIxxx) to destination range(C6:Uxxx)
My VBA code starts with a cell and loops to the end of the column to finish copying that column's data:
Set s = Worksheets("Source")
Set d = Worksheets("Destination")
Dim i As Integer, j As Integer
j = 6
For i = 5 To 1500
If s.Cells(i, 1).Value = "a" Or s.Cells(i, 1).Value = "b" Then
d.Cells(j, 3).Value = s.Cells(i, 17).Value
j = j + 1
End If
Next i
I have > 20 columns to move, is there a way I can copy the row at once? something like this:
d.Cells(j, 3:21).Value = s.Cells(i, 17:35).Value
At the moment, I'm having to specify each column:
d.Cells(j, 3).Value = s.Cells(i, 17).Value 'column 1
d.Cells(j, 4).Value = s.Cells(i, 18).Value 'column 2
d.Cells(j, 5).Value = s.Cells(i, 19).Value 'column 3
etc
You can do it by
d.range(d.cells(j,3), d.cells(j,21)).copy
s.range(s.cells(i,17), s.cells(i,35)).pastespecial xlvalues
You can use:
.Range(<your_range>).copy
For example do:
Activesheet.Range("A1:B10").Copy
and thenjust paste anywhere you want with .Paste
ActiveSheet.Paste Destination:=Worksheets(2).Range("D1:D5")
It's a build in function in vba.
See here also for copying Range:
https://msdn.microsoft.com/en-us/library/office/ff837760.aspx
And for Paste:
https://msdn.microsoft.com/en-us/library/office/ff821951.aspx
Using ranges instead can make it a bit easier:
Dim s As Range, d As Range
Set d = Worksheets("Destination").Cells(6, 15) ' notice the column 15
For Each s in Worksheets("Source").Range("A5:A1500")
If s = "a" Or s = "b" Then
d(,3) = s(,3)
d(,4) = s(,4)
' or d(,3).Resize(,19) = s(,3).Resize(,19) ' .Value optional
Set d = d.Offset(1) ' move to next row
End If
Next
There are easier ways to do that without VBA. For example Power Query, PivotTable, Copy Link and Table Filter, Data tab > From Access, etc.
I've what seems like a pretty simple application with looping and 'If..Then' statements but need some help on structuring it.
In very a basic example, I have a list numbers in column A and the values PM or AM listed in column B. I want to write a loop that will search every value in column B until the end of the data set, and add 12 to each value in column A each time column B has a value of PM. In a nutshell, it would look like this:
If column B = PM
then add 12 to its corresponding cell in column A
else move down to the next row and do the same thing until you reach an empty cell
There are many ways, here is a typical one:
Sub dural()
Dim i As Long
i = 1
Do While Cells(i, "B").Value <> ""
If Cells(i, "B").Value = "PM" Then
Cells(i, "A").Value = Cells(i, "A").Value + 12
End If
i = i + 1
Loop
End Sub
you can set it with For next loop and 2 variables. one for last row and the 2nd for the row count:
Sub Macro1()
Dim LastRow As String
Dim i As Integer
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To LastRow
If Cells(i, 2).Value = "PM" Then Cells(i, 1).vlaue = Cells(i, 1).vlaue + 10
Next i
End
'
End Sub
This is another way to do this.
Option Explicit
Sub Add()
Dim rData As Range
Dim r As Range
Set rData = Cells(1, 1).CurrentRegion.Columns("B").Cells
For Each r In rData
If UCase$(r.Value) = "PM" Then
r.Offset(, -1).Value = r.Offset(, -1).Value + 12
End If
Next r
End Sub
I want to copy values from one column to another column (into the same row) if the cell contains the word IN and delete the original value. If not, the code should proceed to the next row and perform a new test. Thus the cell in the target column will remain empty.
When I run the code in Excel nothing happens, so I don't know what is wrong.
Ideally the code should jump to the next column (8) and do the same search and paste the value into the same column (5) when it is done with the first column, but this I haven't started with yet. So I do appreciate tips for that as well :)
Sub Size()
Dim i As Integer, a As String
i = 2
a = "IN"
Do While Cells(i, 7).Value <> ""
If InStr(Cells(i, 7), a) Then
'copying the value to another column but within the same row
Cells(i, 7).Copy Cells(i, 5)
Cells(i, 7).Clear
i = i + 1
Else
i = i + 1
End If
Loop
End Sub
I found out that my first cell in column 7 was empty and thus the Do While Cells(i, 7).Value <> "" wasn't working. Hence I'm refering to a different column that always contain data. Note that the solution code also jumps to the 2 next columns in order to search for the same word.
Sub Size()
Dim i As Integer, a As String
j = 0
i = 1
a = "IN"
Range("A1").Offset(i, 0).Select
For j = 0 To 2
Do Until Selection.Value = ""
If InStr(Range("G1").Offset(i, j).Value, a) Then
Range("E1").Offset(i, 0).Value = Range("G1").Offset(i, j).Value
Range("G1").Offset(i, j).Clear
i = i + 1
Range("A1").Offset(i, 0).Select
Else
i = i + 1
Range("A1").Offset(i, 0).Select
End If
Loop
i = 1
Range("A1").Offset(i, 0).Select
Next j
End Sub