I am trying to use the AutoFilter and getting the criteria using a values from a different sheet, however its only getting the count value of the last record in the loop.
For iLoop = 1 To 10
Selection.AutoFilter Field:=8, Criteria1:=Worksheets("Sheet3").Cells(iLoop, 1).Value
Dim LR As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
Range("A2:AD" & LR).SpecialCells(xlCellTypeVisible).Select
ActiveSheet.Range("$A$1:$AD$146").AutoFilter Field:=5, Criteria1:=RGB(255, _
0, 0), Operator:=xlFilterCellColor
cCnt = ActiveSheet.AutoFilter.Range.Columns(5).SpecialCells(xlCellTypeVisible) _
.Cells.Count - 1
ActiveSheet.ShowAllData
Worksheets("Sheet3").Range("B2:B11").Value = cCnt
Next iLoop
It looks like your problem is that this:
Worksheets("Sheet3").Range("B2:B11").Value = cCnt
assigns the (only) value stored in cCnt to the same range over and over. So it's getting (possibly) different values in each iteration of the loop, but you're only seeing the last one.
Perhaps what you intended to do is something like:
Worksheets("Sheet3").Range("B" & iloop + 1).Value = cCnt
So, in the first iteration of the loop (when iLoop=1), it will assign the value in cCnt to Cell B2. When iLoop=2, it will assign cCnt to B3, etc...
More Information:
VBA For Loop – A Complete Guide
Related
I have a list of product codes where I want to mark it ** at the end of the code if there is different location.
To elaborate that, an example of the product code is PFL512241-02 where 02 is the location code. So if I get PFL512241-02 and PFL512241-03 in the list, I would like mark my result as PFL512241-02**; so smaller number of my location. If PFL512241-02 shows up 5 times, result should be PFL512241-02. If PFL512241-02 shows up one time, then I want to ignore it since I only want products that showed up more than 1 time. I am also calculating occurrence for each product.
Now my codes will only get me the product codes without ** so I need help on that part.
Option Explicit
Sub ProductNumT()
'Set up'
Dim LR1, LR2, LR3, LR4, LR5, LR6, LR7, LR8, LR9, i, j, k, l, m, n As Long
Dim Rng1, Rng2, Rng3, Rng4, cell As Range
Dim Selection, CBA, PNT As Worksheet
Set CBA = Worksheets("Master")
Set PNT = Worksheets("ProductNumT")
Set Selection = Worksheets("Selection")
LR1 = CBA.Cells(Rows.Count, "A").End(xlUp).Row
'Clear values
PNT.Columns("A:J").ClearContents
'Find products
With CBA.Range("C2", "C" & LR1)
.AutoFilter
.AutoFilter Field:=14, Criteria1:=Selection.Range("B6").Value
.Copy
PNT.Range("B2").PasteSpecial Paste:=xlPasteValues
.AutoFilter
End With
'Sort
PNT.Range("B2", "B" & LR1).Sort _
Key1:=Range("B1"), Order1:=xlAscending
'Product w/o location
LR2 = PNT.Cells(Rows.Count, "B").End(xlUp).Row
With PNT.Range("C2", "C" & LR2)
.FormulaR1C1 = "=LEFT(RC[-1],9)"
.Value = .Value
End With
For k = 2 To LR2
PNT.Cells(k, 1).Value = 1
Next k
'Find duplicates & extract unique values from the list
PNT.Range("D2", "D" & LR2).Formula = "=SUMIFS(C1,C3,RC[-1])"
PNT.Range("D2", "D" & LR2).Copy
PNT.Range("D2").PasteSpecial Paste:=xlPasteValues
For i = 2 To LR2
If PNT.Cells(i, 4).Value <= 1 Then
PNT.Rows(i).ClearContents
End If
Next i
PNT.Range("B1").ClearContents
PNT.Range("D2", "D" & LR2).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
PNT.Range("C2", "C" & LR1).Copy
PNT.Range("E2").PasteSpecial Paste:=xlPasteValues
PNT.Range("E2", "E" & LR1).RemoveDuplicates Columns:=1, Header:=xlNo
'Main calculation
LR4 = PNT.Cells(Rows.Count, "E").End(xlUp).Row
With PNT.Range("F2", "F" & LR4)
.FormulaR1C1 = "=INDEX(C2,MATCH(RC[-1],C3,0))"
.Value = .Value
End With
With PNT.Range("G2", "G" & LR4)
.FormulaR1C1 = "=INDEX(C4,MATCH(RC[-1],C2,0))"
.Value = .Value
End With
End Sub
First picture is what I have now, and second picture is my desire results.
I believe the following formula should work for column F
.FormulaR1C1 = "=INDEX(C2,MATCH(RC[-1],C3,0))&IF(COUNTIF(C2,INDEX(C2,MATCH(RC[-1],C3,0)))<COUNTIF(C3,RC[-1]),""**"","""")"
It counts how many occurrences there are of PFL180437-02 (for instance) in column B and, if that is less than the number of occurrences of PFL180437 in column C (and therefore there is some other PFL180437-xx), it appends an "**".
Not an answer, but ...
Dim LR1, LR2, LR3, LR4, LR5, LR6, LR7, LR8, LR9, i, j, k, l, m, n As Long
Dim Rng1, Rng2, Rng3, Rng4, cell As Range
Dim Selection, CBA, PNT As Worksheet
Selection is a VBA object. You can't have a variable by that name.
In the first line, only n is a Long. All the others are undefined, meaning variants. In the second line, only cell is a range, all others undefined and therefore variants. In the third line, only PNT is a worksheet, all others undefined and therefore variants.
I have a loop that needs to stop when activecell value is "BBSE", but it passes the cell and continues the loop. someone can help me with that?
I cut rows from table in one workbbok and paste it to another. before the list in column F I have many blank cells, and because of that I am usind xldown.
Here is the relevant code:
'Illuminators Worksheet
OP_wb.Activate
Range("F2").End(xlDown).Select
Do Until ActiveCell.Value = "BBSE"
OP_wb.Activate
Worksheets("Optic Main").Activate
Range("F2").End(xlDown).Select
Selection.EntireRow.Cut
Demand_WB.Activate
Worksheets("Illuminators").Activate
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveSheet.Paste
Loop
Here is where I want to stop the loop in the red circle:
this is why I am using END.xlDown
If I understand what you are trying to achieve correctly, I believe the following will achieve it:
Dim startRow As Long
Dim endRow As Long
With OP_wb.Worksheets("Optic Main")
startRow = .Range("F2").End(xlDown).Row
endRow = .Columns("F").Find(What:="BBSE", LookIn:=xlValues, LookAt:=xlWhole).Row
.Rows(startRow & ":" & endRow).Cut
End With
With Demand_WB.Worksheets("Illuminators")
.Range("A" & .Rows.Count).End(xlUp).Offset(1).Insert Shift:=xlDown
End With
May be try like this...
'Mentioning Starting Row Here
x = 2
Do
'x refers to Row and F refer to column name
With Cells(x, "F")
'Exiting Do Loop once it finds the matching value using If statement
If .Value = "BBSE" Then Exit Do
OP_wb.Activate
Worksheets("Optic Main").Activate
.EntireRow.Cut
Demand_WB.Activate
Worksheets("Illuminators").Activate
Range("A" & Rows.Count).End(xlUp).Offset(1).Select
ActiveSheet.Paste
End With
'Incrementing row number here to move on to next row
x = x + 1
Loop
I am a new user of VBA and am trying to do the following (I got stuck towards the end):
I need to locate the first empty cell across every row from column C to P (3 to 16), take this value, and paste it in the column B of the same row.
What I try to do was:
Find non-empty cells in column C, copy those values into column B.
Then search for empty cells in column B, and try to copy the first non-empty cell in that row.
The first part worked out fine, but I am not too sure how to copy the first non-empty cell in the same row. I think if this can be done, I might not need the first step. Would appreciate any advice/help on this. There is the code:
Private Sub Test()
For j = 3 To 16
For i = 2 To 186313
If Not IsEmpty(Cells(i, j)) Then
Cells(i, j - 1) = Cells(i, j)
End If
sourceCol = 2
'column b has a value of 2
RowCount = Cells(Rows.Count, sourceCol).End(xlUp).Row
'for every row, find the first blank cell, copy the first not empty value in that row
For currentRow = 1 To RowCount
currentRowValue = Cells(currentRow, sourceCol).Value
If Not IsEmpty(Cells(i, 3)) Or Not IsEmpty(Cells(i, 4)) Or Not IsEmpty(Cells(i, 5)) Or Not IsEmpty(Cells(i, 6)) Then
Paste
~ got stuck here
Next i
Next j
End Sub
Your loop is really inefficient as it is iterating over millions of cells, most of which don't need looked at. (16-3)*(186313-2)=2,422,043.
I also don't recommend using xlUp or xlDown or xlCellTypeLastCell as these don't always return the results you expect as the meta-data for these cells are created when the file is saved, so any changes you make after the file is saved but before it is re-saved can give you the wrong cells. This can make debugging a nightmare. Instead, I recommend using the Find() method to find the last cell. This is fast and reliable.
Here is how I would probably do it. I'm looping over the minimum amount of cells I can here, which will speed things up.
You may also want to disable the screenupdating property of the application to speed things up and make the whole thing appear more seemless.
Lastly, if you're new to VBA it's good to get in the habit of disabling the enableevents property as well so if you currently have, or add in the future, any event listeners you will not trigger the procedures associated with them to run unnecessarily or even undesirably.
Option Explicit
Private Sub Test()
Dim LastUsed As Range
Dim PasteHere As Range
Dim i As Integer
Application.ScreenUpdating=False
Application.EnableEvents=False
With Range("B:B")
Set PasteHere = .Find("*", .Cells(1, 1), xlFormulas, xlPart, xlByRows, xlPrevious, False, False, False)
If PasteHere Is Nothing Then Set PasteHere = .Cells(1, 1) Else: Set PasteHere = PasteHere.Offset(1)
End With
For i = 3 To 16
Set LastUsed = Cells(1, i).EntireColumn.Find("*", Cells(1, i), xlFormulas, xlPart, xlByRows, xlPrevious, False, False, False)
If Not LastUsed Is Nothing Then
LastUsed.Copy Destination:=PasteHere
Set PasteHere = PasteHere.Offset(1)
End If
Set LastUsed = Nothing
Next
Application.ScreenUpdating=True
Application.EnableEvents=True
End Sub
Sub non_empty()
Dim lstrow As Long
Dim i As Long
Dim sht As Worksheet
Set sht = Worksheets("Sheet1")
lstrow = sht.Cells(sht.Rows.Count, "B").End(xlUp).Row
For i = 1 To lstrow
If IsEmpty(Range("B" & i)) Then
Range("B" & i).Value = Range("B" & i).End(xlToRight).Value
End If
Next i
End Sub
I don't understand syntax for range.
Why does this work:
For i = 1 To 10
Range("A" & i & ":D" & i).Copy
Next
But this doesn't work:
For i = 2 To lastRow
num = WorksheetFunction.Match(Cells(i, 1), Range("A" & lastRow), 0)
Next
Why do I need to use
For i = 2 To lastRow
'num = WorksheetFunction.Match(Cells(i, 1), Range("A1:A" & lastRow), 0)
Next
What A1:A mean? Why can't I use
Range("A" & lastRow), 0
There is nothing wrong with your syntax and your code should've work just fine.
The problem with using worksheet function like Match, Vlookup and other look up functions is that if the value being searched is not found, it throws up an error.
In your case, you are trying to search multiple values in just one cell.
So let us say your lastrow is 9. You're code will loop from Cell(2,1) to Cell(9,1) checking if it is within Range("A" & lastrow) or Range("A9").
If your values from Cell(2,1) through Cell(9,1) is the same as your value in Range("A9"), you won't get an error.
Now, if you use Range("A1:A" & lastrow), it will surely work cause you are trying to match every element of that said range to itself and surely a match will be found.
WorksheetFunction.Match(Cells(2,1), Range("A1:A9")) 'will return 2
WorksheetFunction.Match(Cells(3,1), Range("A1:A9")) 'will return 3
'
'
'And so on if all elements are unique
It doesn't matter if you use Range("A9") or Range("A1:A9").
What matters is that you handle the error in case you did not find a match.
One way is to use On Error Resume Next and On Error Goto 0 like this:
Sub ject()
Dim num As Variant
Dim i As Long, lastrow As Long: lastrow = 9
For i = 2 To lastrow
On Error Resume Next
num = WorksheetFunction.Match(Cells(i, 1), Range("A" & lastrow), 0)
If Err.Number <> 0 Then num = "Not Found"
On Error GoTo 0
Debug.Print num
Next
End Sub
Another way is to use Application.Match over WorksheetFunction.Match like this:
Sub ject()
Dim num As Variant
Dim i As Long, lastrow As Long: lastrow = 9
For i = 2 To lastrow
num = Application.Match(Cells(i, 1), Range("A" & lastrow), 0)
Debug.Print num
'If Not IsError(num) Then Debug.Print num Else Debug.Print "Not Found"
Next
End Sub
Application.Match works the same way but it doesn't error out when it returns #N/A. So you can assign it's value in a Variant variable and use it later in the code without any problem. Better yet, use IsError test to check if a value is not found as seen above in the commented lines.
In both cases above, I used a Variant type num variable.
Main reason is for it to handle any other value if in case no match is found.
As for the Range Syntax, don't be confused, it is fairly simple.
Refer to below examples.
Single Cell - All refer to A1
Cells(1,1) ' Using Cell property where you indicate row and column
Cells(1) ' Using cell property but using just the cell index
Range("A1") ' Omits the optional [Cell2] argument
Don't be confused with using cell index. It is like you are numbering all cells from left to right, top to bottom.
Cells(16385) ' refer to A2
Range of contiguous cell - All refer to A1:A10
Range("A1:A10") ' Classic
Range("A1", "A10") ' or below
Range(Cells(1, 1), Cells(10, 1))
Above uses the same syntax Range(Cell1,[Cell2]) wherein the first one, omits the optional argument [Cell2]. And because of that, below also works:
Range("A1:A5","A6:A10")
Range("A1", "A8:A10")
Range("A1:A2", "A10")
Non-Contiguous cells - All refer to A1, A3, A5, A7, A9
Range("A1,A3,A5,A7,A9") ' Classic
Without any specific details about the error, I assume that Match does not return the value you expect, but rather an #N/A error. Match has the syntax
=match(lookup_value, lookup_range, match_type)
The lookup_range typically consists of a range of several cells, either a column with several rows or a row with several columns.
In your formula, you have only one cell in the lookup_range. Let's say Lastrow is 10. The first three runs of the loop produce the formula
=Match(A2,A10,0)
=Match(A3,A10,0)
=Match(A4,A10,0)
It is a valid formula but in most cases the result won't be a match but an error. Whereas what you probably want is
=Match(A2,A1:A10,0)
Looking again at your code, stitch it together and find why you need A1:A as a string constant in your formula:
For i = 2 To lastRow
num = WorksheetFunction.Match(Cells(i, 1), Range("A1:A" & lastRow), 0)
Next
I have two sheets of data. One sheet has Primary Id with 4 fields and other has primary Id with 2 fields.
Sheet A Sheet B
ID Name Price Type Category ID Name Price
1 S Normal 2 Aus 500
2 N Default 1 Ind 400
Basically I need to match the ID of both sheets and copy the corresponding Name and Price in sheet A form Sheet B. I have tried the following code,
Sub Copy()
lastrowA = Worksheets("SheetA").Cells(Rows.Count, "A").End(xlUp).Row + 1
Set rngA = Range("A2" & lastrowA)
lastrowB = Worksheets("SheetB").Cells(Rows.Count, "A").End(xlUp).Row + 1
Set rngB = Range("A2" & lastrowB)
For Each x In rngB
For Each y In rngA
If x.Value() = y.Value Then
' Copy paste name and price form B to A
End If
Next
Next
End Sub
It's never a good idea to use a reserved word as the name of your macro. Particularly so if you plan to use a .Copy operation within the macro.
Sub MyCopy()
Dim lastrowA As Long
With Worksheets("SheetA")
lastrowA = .Cells(Rows.Count, "A").End(xlUp).Row
With .Range("B2:C" & lastrowA)
.Formula = "=IFERROR(VLOOKUP($A2, 'SheetB'!$A:$C, COLUMN(B:B), FALSE), """")"
.Value = .Value
End With
End With
End Sub
That bulk populates the entire region with the appropriate formula without looping then converts the returned values to raw values. Any non-matches will be blank rather than #N/A errors.
Does it have to be done without using formulas? I'm not sure if I'm missing something, but surely you can just use either a Vlookup or an Index Match?
If entering the formula from VBA:
Cells(2,2).FormulaR1C1 = "=INDEX(Sheet2!R2C2:R3C3,MATCH(RC[-1],Sheet2!RC[-1]:R[1]C[-1],0),1)"
Cells(2,3).FormulaR1C1 = "=INDEX(Sheet2!R2C2:R3C3,MATCH(RC[-2],Sheet2!R2C1:R3C1,0),2)"
Then you can find the last row in the ID column on sheet 1, and fill the formula down both of the columns. Once the formula has been filled down, just copy and paste as values.
Dim lstRow As Long
lstRow = Sheets("Sheet 1").Cells(Rows.Count, 1).End(xlUp).Row '' find last row
Range(Cells(2, 2), Cells(lstRow, 3)).FillDown
Range(Cells(2, 2), Cells(lstRow, 3)).Copy
Cells(2, 2).PasteSpecial Paste:=xlPasteValues
Edit: You can use the lstRow variable within the VBA formula to make sure the formula is covering the whole range everytime the automation is run. You can use the 'Record Macro' button within excel to get the code for a formula, if you are not comfortable creating them yourself.
The Problem with your code is that
Set rngA = Range("A2" & lastrowA)
evaluates to Range("A25") for lastRowA=5.
If you want to address multiple cells, use
Set rngA = Range("A2:A" & lastrowA)
to get Range("A2:A5") for lastRowA = 5.
Besides that, formulas as already mentioned are an elegant solution as well.