I am having difficulty in making comparison and replacing value in excel. It would be great if someone can help me out and guide me.
There are ticket no's in both the sheets. I would like to compare ticket number, if they matches then copy type and subtype from sheet1 to sheet2 type and subtype column. I am attaching image for your reference
If you would like to use VBA, this may help you:
Option Explicit
Sub test()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim ws1LastRow As Long, i As Long, ws2LastRow As Long, y As Long
Dim ws1TicketNo As String, ws2TicketNo As String, ws1Type As String, ws2Type As String, ws1SubT As String, ws2SubT As String
Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Set ws2 = ThisWorkbook.Worksheets("Sheet2")
ws1LastRow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
ws2LastRow = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row
For i = 2 To ws1LastRow
ws1TicketNo = ws1.Range("A" & i).Value
ws1Type = ws1.Range("B" & i).Value
ws1SubT = ws1.Range("C" & i).Value
For y = 2 To ws2LastRow
ws2TicketNo = ws2.Range("A" & i).Value
ws2Type = ws2.Range("B" & i).Value
ws2SubT = ws2.Range("C" & i).Value
If ws1TicketNo = ws2TicketNo Then
ws2.Range("B" & i).Value = ws1Type
ws2.Range("C" & i).Value = ws1SubT
Exit For
End If
Next y
Next i
End Sub
Sheet 1:
Sheet 2:
Result:
You can use VLOOKUP function.
With that formula, you can search each ticket number from sheet2, search the info in sheet1 and return the value you want (type or subtype).
Something like =VLOOKUP(A2;Sheet1!$A$2:$B$4;2;FALSE) should work for you. adap it to your needs
Related
I need column J to be filled with the value 1 in all cells until the rows that are filled in column A. Could someone provide me with the vba code for the same? Thanks in advance.
If you want to autofill 2010 until the row of column B with value 1:
Sub test()
Dim lastrow As Long
lastrow = Range("B" & Rows.Count).End(xlUp).Row
Range("A2:A" & lastrow).Value = 2010
End Sub
Give a try on below codes-
Sub FillCells()
Dim lr As Long, i As Long
Dim rng As Range
lr = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To lr
Cells(i, "J") = 1
Next i
End Sub
Please, try the next code line:
Range("J2:J" & Range("A" & rows.count).End(xlUp).row).Value = 1
Edited
You asked in a comment to another answer something about doing it for specific sheets.
Please, try the next way:
Dim ws As Worksheet, i As Long
For i = 2 To 5
Set ws = ActiveWorkbook.Worksheets(i)
ws.Range("J2:J" & ws.Range("A" & ws.rows.count).End(xlUp).row).Value = 1
Next i
I have a list of about 2000 values in column A in Excel, and then a list of the start and end of value ranges in the next two columns. The range values don't correspond to the values in the first column. I want to check, for every value in column A, whether the value falls within ANY of the ranges listed in columns B and C.
So for example, in the image below, see whether A2 falls within B2-C2, B3-C3, OR B4-C4. Then the same again for A3 and A4. For each of these I want true/false to be entered in column D. The true/false value would correspond to the values in column A.
I've been trying to do this in VBA but I'm not totally confident with getting it to search the ranges. Current code is below.
Sub CheckRg()
Dim wk As Worksheet, frow As Long, i As Long
Set wk = Sheet1
frow = wk.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To frow
If wk.Range("A" & i).Value >= wk.Range("B:B").Value And wk.Range("A" & i).Value <= wk.Range("C:C").Value Then
wk.Range("D" & i).Value = "TRUE"
Else
wk.Range("D" & i).Value = "FALSE"
End If
Next i
End Sub
This formula should do the trick without VBA:
=COUNTIFS($B:$B,"<="&A2,$C:$C,">="&A2)<>0
You can use it in your code like this:
Sub CheckRg()
Dim wk As Worksheet, frow As Long, i As Long
Set wk = Sheet1
frow = wk.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To frow
With Excel.WorksheetFunction
wk.Range("D" & i).Value = .CountIfs(wk.Range("B:B"), Evaluate("""<=""" & "&A" & i), wk.Range("C:C"), Evaluate(""">=""" & "&A" & i)) <> 0
End With
Next i
End Sub
An Inefficient Double Loop
A better way to go is presented in the solution by Evil Blue Monkey.
You need to check each cell in column A against each cell pair of columns B and C which requires a second loop that slows down the operation when thousands of rows are expected.
Here's an example of how you could go about that.
Sub CheckRg()
Dim ws As Worksheet: Set ws = Sheet1
Dim lRow As Long: lRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
Dim i As Long
Dim j As Long
Dim MatchFound As Boolean
For i = 2 To lRow
For j = 2 To lRow
If ws.Range("A" & i).Value >= ws.Range("B" & j).Value _
And ws.Range("A" & i).Value <= ws.Range("C" & j).Value Then
MatchFound = True
Exit For
End If
Next j
If MatchFound Then
ws.Range("D" & i).Value = True
MatchFound = False
Else
ws.Range("D" & i).Value = False
End If
Next i
Application.ScreenUpdating = True
MsgBox "Range checked.", vbInformation
End Sub
Not sure if I did the code correctly but it is there.
My quandary is this line ws.Range("B" & J, Range("K" & J)).copy. It is giving me a Run-time error 1004 Method range of object worksheet failed.
What I am trying to do is copy/paste any row b:k if column "P" indicated "recorded".
Your assistance is greatly appreciated. Thank you.
Sub Clear_Recorded()
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim lRow As Integer 'Data Tab
Dim count As Integer
Set ws = Sheet1 'Data
Set ws1 = Sheet11 'Archive
count = 0
lRow = ws.Range("B" & Rows.count).End(xlUp).Row
For J = 2 To lRow
If ws.Range("P" & J).Value = "Recorded" Then
count = count + 1
ws.Range("B" & J, Range("K" & J)).copy
ws1.Range("A" & count).PasteSpecial
End If
Next J
You just need to get rid of the second "Range" and the extra parenthesis. Hope this helps!
ws.Range("B" & J, "K" & J).Copy
Edit: Spelling
You are trying to set a worksheet object without referencing any kind of sheet.
How to fix this issue:
set ws = Thisworkbook.Sheets("SheetName")
Also you should rather use this:
if ws.Range("P2").Offset(J-1) = "Recorded" then
'Rest of code goes here
.Offset has the parameters RowOffset ,ColumnOffset
This should solve your problem.
I need a macro to write the row values present in column A if there is a value present in column B .
For example :
Column A Column B
Arjun
Arun 12
For the above example, I need a macro which can write "Arun 12" in Sheet2 of the work book with the Headers "Name" and "Hours".Before this the macro should clear the data present in Sheet two completely.
This will copy the all rows of columns A and B from Sheet1 to Sheet2 if B is not a Null string. And also will add the headers "Name" and "Hours".
Option Explicit 'requires that every variable has to be defined before use, e.g. with a Dim statement.
Sub DoStuff_GoodPractice()
Dim lastRowSrc As Long, lastRowDest As Long, i As Long 'declare row counts as Long so all rows can be used
Dim shtSource As Worksheet, shtDestination As Worksheet
Set shtSource = ThisWorkbook.Worksheets("Sheet1") 'full qualified identification of the worksheets
Set shtDestination = ThisWorkbook.Sheets("Sheet2")
lastRowSrc = shtSource.Range("A" & shtSource.Rows.Count).End(xlUp).Row 'determine the last used row
'clear destination sheet and write headers:
shtDestination.Cells.Clear
shtDestination.Range("A1").Value = "Name"
shtDestination.Range("B1").Value = "Hours"
lastRowDest = 1 'start with row 1 as destination
For i = 1 To lastRowSrc 'loop through all used rows
If shtSource.Range("A" & i).Value <> vbNullString And _
shtSource.Range("B" & i).Value <> vbNullString Then 'check if cells are not a null string
shtSource.Range("A" & i & ":B" & i).Copy Destination:=shtDestination.Range("A" & lastRowDest + 1) 'copy current row
lastRowDest = lastRowDest + 1 'jump to the last used row in destination
End If
Next i
End Sub
This should accomplish what you're after.
Sub DoStuff()
Dim lastRow As integer, lastRowSheet2 As integer, i As Integer
Dim sheet1 As WorkSheet, sheet2 As Worksheet
Set sheet1 = Sheets("Sheet1")
Set sheet2 = Sheets("Sheet2")
lastRow = sheet1.Range("A" & Rows.Count).End(xlUp).Row
sheet2.Cells.Clear
For i = 1 To lastRow
If sheet1.Range("A" & i).Value <> "" And sheet1.Range("B" & i).Value <> "" then
lastRowSheet2 = sheet2.Range("A" & Rows.Count).End(xlUp).Row
sheet1.Range("A" & i & ":B" & i).Copy Destination:= sheet2.Range("A" & lastRowSheet2 + 1)
End If
Next i
End Sub
I Have a Column C that has names in all its cells and another Column E that has the same company name in all its cells I need to append the names in Column C to the company name in column E
Thanks
Ex:
ColC ColE
Bob SampleCo
Sally SamplCo
I get
ColC ColE
Bob SampleCo Bob
Sally SamplCo Sally
I am trying but failing with
Sub CompanyName()
Dim LastRow As Long
Dim Ws As Worksheet
Dim rRange As range
Set rRange = range("E2")
rRange.Select
Set Ws = Sheets("WP_SubjectList_Ready")
LastRow = Ws.range("F" & Ws.Rows.Count).End(xlUp).Row
Ws.range("E2:E" & LastRow).FormulaR1C1 = "=rRange &RC[-1]"
range("E2:E" & LastRow).Copy
range("E2:E" & LastRow).PasteSpecial xlPasteValues
End Sub
Code
Sub CompanyName()
Dim LastRow As Long
Dim Ws As Worksheet
Set Ws = Sheets("WP_SubjectList_Ready")
LastRow = Ws.Range("E" & Ws.Rows.Count).End(xlUp).Row
Ws.Range("F2:F" & LastRow).FormulaR1C1 = "= RC[-1] & "" "" & RC[-3]"
End Sub
If you want the output in Column E its not possible using FormulaR1C1.
Any formula which work for excel interface will work for FormulaR1C1.
With that i mean (considering the image) in cell F2 you can manullay enter a formula = E2 & " " & C2 which will give you desired output. But if you enter in cell E2the formula as =E2 & " " & C2 the cell E2 will loose its value and this may even lead to circular reference issue.
It can be achieved using below code.
Sub CompanyName()
Dim LastRow As Long
Dim Ws As Worksheet
Dim rng As Range, cell As Range
Set Ws = Sheets("WP_SubjectList_Ready")
LastRow = Ws.Range("E" & Ws.Rows.Count).End(xlUp).Row
Set rng = Ws.Range("E2:E" & LastRow)
For Each cell In rng
cell = cell & " " & cell.Offset(0, -2)
Next
End Sub
Here's some code that should help you with what you want...I don't typically use ranges for loops because it's easier to use .Cells(row, col) for me, but anyways:
EDIT: Added Sub Opening/Closing Syntax and edited to use WS instead of ActiveSheet so it's closer to what you want
Sub CompanyName()
Dim WS as Worksheet
Dim vRow
Dim vRowCount As Integer
Set WS = Sheets("WP_SubjectList_Ready")
'Gets Row # of Last Row for Column E
vRowCount = Range("E" & Rows.Count).End(xlUp).row
'Assuming Both Columns have the same row count and you have a header row
For vRow = 2 To vRowCount
WS.Cells(vRow, 5).Value = WS.Cells(vRow, 5).Value & " " & WS.Cells(vRow, 3).Value
Next vRow
End Sub