I am currently trying to do mathematical operation of adding 3 columns (Y, AA and AB).
But each time running the code, it displays error message of
object is required
Sub QCValue()
Dim Number1 As Range
Dim Number2 As Range
Dim Number3 As Range
Set Number1 = Sheets("RawData").Range("Y2:Y" & Range("A" & Rows.Count).End(xlUp).Row)
Set Number2 = Sheets("RawData").Range("AA2:AA" & Range("A" & Rows.Count).End(xlUp).Row)
Set Number3 = Sheets("RawData").Range("AB2:AB" & Range("A" & Rows.Count).End(xlUp).Row)
Sheets("RawData").Range("AJ2:AJ" & Range("A" & Rows.Count).End(xlUp).Row).Value = Number1 + Number2 + Number3
End Sub
Kindly please assist me in troubleshooting.
You have work a loop for that. Like this below should do the job.
Sub QCValue()
Dim i As Integer
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
Sheets("RawData").Range("AJ" & i).Value = Sheets("RawData").Range("Y" & i).Value + Sheets("RawData").Range("AA" & i).Value + Sheets("RawData").Range("AB" & i).Value
Next
End Sub
If i have understand correctly you could use:
Code:
Option Explicit
Sub QCValue()
Dim LastRow As Long
With ThisWorkbook.Sheets("RawData")
'Find Last rows of Columns Y
LastRow = .Cells(.Rows.Count, "Y").End(xlUp).Row
.Range("AJ2:AJ" & LastRow).FormulaR1C1 = "=SUM(RC[-11],RC[-9],RC[-8])"
End With
End Sub
Results:
Related
I am new in VBA so i just look for the code online and i modify it for my files.
I would like to know if i can put together the following 2 macros.
It looks for contract number in column AF and then changes the Customer Name (col AN) & Customer Group Name (col AP). can it be donein another way?
I would like to simplify it as later i need, based on Contract Number to change 5 more variables in 5 different columns for other customers.
Sub CorrectCustomerNameXXXX()
Dim LastRow As Long
Dim i As Long
LastRow = Range("AF1000000").End(xlUp).Row
For i = LastRow To 1 Step -1
If Range("AF" & i) = "006-0146157-001" Then
Range("AN" & i).Value = "CUSTOMER_NAME"
End If
Next
End Sub
Sub CorrectCustomerGROUPNameXXXX()
Dim LastRow As Long
Dim i As Long
LastRow = Range("AF1000000").End(xlUp).Row
For i = LastRow To 1 Step -1
If Range("AF" & i) = "006-0146157-001" Then
Range("AP" & i).Value = "CUSTOMER_GROUP"
End If
Next
End Sub
Thanks in advance for your help
Try this code, please. You should use the same iteration:
Sub CorrectWhatever()
Dim LastRow As Long, i As Long
LastRow = Range("AF" & rows.count).End(xlUp).Row
For i = 1 To LastRow
If Range("AF" & i).Value = "006-0146157-001" Then
Range("AN" & i).Value = "CUSTOMER_NAME"
Range("AP" & i).Value = "CUSTOMER_GROUP"
End If
Next
End Sub
I have data in B Column of an excel file. I have made a loop that If the value in B Cell is greater than a particular (len1) value, then the code puts the Cell (Value-Len1) value in a new cell at the end of the rows.
I increment the counter as lastrow = lastrow+1 everytime when the row is added. Now here is the problem. Iniitially in the input file I had 122 set of data. But by the time the For loop finishes the value of lastrow becomes 160, but the loop exits at 122. WHY?? Any Help will be appreciated.
For i = 1 To lastrow Step 1
If Range("B" & i).Value > len1 Then
Range("A" & lastrow + 1).Value = Range("A" & i).Value
Range("B" & lastrow + 1).Value = Range("B" & i).Value - len1
Range("B" & i).Value = len1
lastrow = lastrow + 1
End If
Next
To get the behaviour you want you need a while loop (or do loop)
i = 1
While i <= lastrow
If Range("B" & i).Value > len1 Then
lastrow = lastrow + 1
Range("A" & lastrow).Value = Range("A" & i).Value
Range("B" & lastrow).Value = Range("B" & i).Value - len1
Range("B" & i).Value = len1
End If
i = i + 1
Wend
I tested it with the sub below:
Sub LoopBeyondLastRow()
Dim i As Long, lastrow As Long, len1 As Long
len1 = 10
With ThisWorkbook.Sheets("Sheet1")
lastrow = .Cells(Rows.Count, "B").End(xlUp).Row
i = 1
While i <= lastrow
If .Range("B" & i).Value > len1 Then
lastrow = lastrow + 1
.Range("A" & lastrow).Value = .Range("A" & i).Value
.Range("B" & lastrow).Value = .Range("B" & i).Value - len1
.Range("B" & i).Value = len1
End If
i = i + 1
Wend
End With
End Sub
Please note the following:
Inside the loop I incremented lastrow first and then used it in the following 2 statements (to reduce the number of addition operations)
In my test code I added With ThisWorkbook.Sheets("Sheet1") to fully qualify all ranges. Not doing this is the source of many bugs that are sometimes very difficult to pinpoint. One should get in the habbit of never to write Range or Cells without a little . before them.
A faster method would be to export the range values to array and then do the comparision. Store the final output into a temp array and write it back to the worksheet.
If you want to follow your approach then is this what you are trying? I have commented the code so you should not have a problem understanding it. Basically you need 2 loops if you want to recheck the data that you are adding at the end of the row.
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim ComparisionValue As Long
Dim countOfMatchedValues As Long
Dim lRow As Long
Dim i As Long
Dim outputRow As Long
Dim rng As Range
'~~> Change this to the relevant sheet
Set ws = Sheet1
'~~> Change this to the relevant
'~~> comparision value
ComparisionValue = 122
With ws
'~~> Start an indefinite loop
Do
'~~> Find last row
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
'~~> Fix the output row for the new data
outputRow = lRow + 1
'~~> Check if there are any matches for your condition
countOfMatchedValues = Application.WorksheetFunction.CountIf( _
.Range("B1:B" & lRow), ">" & ComparisionValue)
'~~> If not then exit loop
If countOfMatchedValues = 0 Then Exit Do
'~~> Do your stuff
For i = 1 To lRow
If .Range("B" & i).Value > ComparisionValue Then
.Range("A" & outputRow).Value = .Range("A" & i).Value
.Range("B" & outputRow).Value = .Range("B" & i).Value - ComparisionValue
.Range("B" & i).Value = ComparisionValue
outputRow = outputRow + 1
End If
Next i
Loop
End With
End Sub
In Action
for loops use a pre-defined number of iterations. For an unknown number of iterations you need to use a while loop.
Your code uses the value of lastRow at the time it was interpreted, and is never updated again.
This is similar to:
lastRow = 1
Debug.Print lastRow
lastRow = lastRow + 1
Debug.Print lastRow
You will see:
1
2
and not:
2
2
because once the first Debug statement has been executed, changing the value of lastRow doesn't affect this particular output anymore.
Test the next code, please:
Sub TestLoopAddedRowsInclusive()
'..... your code defining LastRow and len1
Dim lastRInit As Long
lastRInit = LastRow
For i = 1 To Rows.count
If Range("B" & i).Value = "" And i >= lastRInit Then Exit For
If Range("B" & i).Value > len1 Then
Range("A" & LastRow + 1).Value = Range("A" & i).Value
Range("B" & LastRow + 1).Value = Range("B" & i).Value - len1
Range("B" & i).Value = len1
LastRow = LastRow + 1
End If
Next
End Sub
I have excel sheet with around 40k records and 5 columns. I want to search duplicates in column 3, 4, 5 and copy whole row in new sheet.
#Emm Jay could you please be more specific? I m not sure what are you asking for, but the below code may help you to get an overall idea.
Let's say that Sheet 1 contains our data & duplicate rows will copy on Sheet 2.
Sheet 1:
Sheet 2 - Output:
Code:
Option Explicit
Sub Duplicates()
Dim LastrowS1 As Long, LastrowS2 As Long, i As Long, j As Long
Dim CombineStrI As String, CombineStrJ As String
LastrowS1 = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
For i = 2 To LastrowS1
CombineStrI = Sheet1.Range("C" & i).Value & "_" & Sheet1.Range("D" & i).Value & "_" & Sheet1.Range("E" & i).Value
For j = 2 To LastrowS1
CombineStrJ = Sheet1.Range("C" & j).Value & "_" & Sheet1.Range("D" & j).Value & "_" & Sheet1.Range("E" & j).Value
If j <> i Then
If CombineStrI = CombineStrJ Then
Sheet1.Rows(i).Copy
LastrowS2 = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row
Sheet2.Range("A" & LastrowS2 + 1).PasteSpecial
End If
End If
Next j
Next i
End Sub
We have a macro working via a button in Excel 2013 to insert a new row with formula from above. the Problem is when it runs and i say for example copy from row 10 the formula in the new row 11 all still read back to row 10 not 11?
Sub Loop_InsertRowsandFormulas()
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Risk Input Sheet")
Dim vRows As Long
Dim lastCol As Long
Dim firstRow As Long
firstRow = InputBox("Enter Row To Start Insert From.")
vRows = InputBox("Enter Number Of Rows Required")
If firstRow = 0 Or vRows = 0 Then Exit Sub
Debug.Print firstRow
IngA = ws.Cells(5, ws.Columns.Count).End(xlToLeft).Column
For myLoop = 1 To vRows
ws.Range("A" & (firstRow + myLoop)).EntireRow.Insert
ws.Range("A" & (firstRow + myLoop) & ":BB" & (firstRow + myLoop)).Formula = ws.Range("A" & firstRow & ":BB" & firstRow).Formula
Next
End Sub
You need to do a Copy/Paste. For example, if A1 contains:
=B1+C1
running:
Sub qwerty()
Range("A2").Formula = Range("A1").Formula
End Sub
will leave A2 with =B1+C1 as well.
If you want the copied formula to "adjust" then:
Sub ytrewq()
Range("A1").Copy Range("A2")
End Sub
EDIT#1:
Rather than:
ws.Range("A" & (firstRow + myLoop) & ":BB" & (firstRow + myLoop)).Formula = ws.Range("A" & firstRow & ":BB" & firstRow).Formula
use something like:
ws.Range("A" & firstRow & ":BB" & firstRow).Copy ws.Range("A" & (firstRow + myLoop) & ":BB" & (firstRow + myLoop))
Cannot take any praise for this. Thanks Dave.
Sub Loop_InsertRowsandFormulas()
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Risk Input Sheet")
Dim vRows As Long
Dim lastCol As Long
Dim firstRow As Long
firstRow = InputBox("Enter Row To Start Insert From.")
vRows = InputBox("Enter Number Of Rows Required")
If firstRow = 0 Or vRows = 0 Then Exit Sub
Debug.Print firstRow
IngA = ws.Cells(5, ws.Columns.Count).End(xlToLeft).Column
For Myloop = 1 To vRows
ws.Range("A" & (firstRow + Myloop)).EntireRow.Insert
ws.Range("N" & (firstRow) & ":AW" & (firstRow + Myloop)).FillDown
Next
End Sub
I have this code to check duplicates, If it find duplicates (or more) in cell L, is it possible to copy the values from cells in the K column into ONE cell?
Sub check_duplicates()
Dim x As Long
Dim LastRow As Long
Dim rng As String
LastRow = Range("L65536").End(xlUp).Row
For x = LastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("L2:L" & x), Range("L" & x).Value) > 1 Then
Range("L" & x).Copy
End If
Next x
End Sub
I hope is what you want to do, let me know.
Sub Test()
Dim lastrow As Long
lastrow = Range("L" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow
lastrow = Range("L" & Rows.Count).End(xlUp).Row
For j = i + 1 To lastrow
If Range("L" & j).Value = Range("L" & i).Value Then
If Not IsEmpty(Range("K" & i)) Then
Range("K" & i) = Range("K" & i) & "," & " " & Range("L" & j)
Rows(j).EntireRow.Delete
Else
Range("K" & i) = Range("L" & j)
End If
j = j - 1
End If
Next j
Next i
End Sub