I'm trying to figure out how to write compare code. I have two sheets', sheet1 and sheet2.
in sheet1 have five digits id numbers in column A, in sheet2 have same five digits id number in column C, but in sheet2 the id number is not the same row as column A in sheet1, they are differents row.
I'm trying to figure out how to make comparisons in sheet1 column A to search for a match in ANY row in sheet2 column B then copy the value from the same row in sheet2 Column C to sheet1 column D!
this is my own testing code but is not working.
Sub FindStuff()
Dim lr As Long
Dim i As Integer
lr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To lr
If UCase(Sheet2.Cells(1, 3).Value) = UCase(Sheet1.Cells(i, 1).Value) Then
Sheet2.Cells(14, 5).Value = Sheet1.Cells(i, 1).Offset(, 5).Value
End If
Next i
End Sub
The code you post has both syntax error and logic error, I'm not sure exactly what you are trying to do. Can you post an workbook example?
I changed your formula with Vlookup in the code, you can test and let me know if this is what you need.
Sub MatchValues()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lr As Long
Dim r As Long
Application.ScreenUpdating = False
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
lr = ws2.Cells(Rows.Count, 3).End(xlUp).Row
For r = 2 To lr
On Error Resume Next
Cells(r, 4) = WorksheetFunction.VLookup(ws2.Cells(r, 3).Value, _
ws1.Range("A:A"), 1, 0)
Next
Application.ScreenUpdating = True
End Sub
Related
I have a workbook with a series of sheets that I need to run a code to resolve the data.
I have one worksheet with a list of "codes" and another sheet that has cells that will include a string of codes.
I am trying to create a macro that allows me to reference a code in sheet1 A1, and then look through B:B in sheet2 and copy the row if the code appears in the string
I am a novice VBA user and have tried googling a few things and I'm not having any luck.
Edit:
I have managed to get something that does copy the data through, but there seems to be an issue in the For loop as all lines are copied in, not just the lines that match. Code below.
Private Sub CommandButton1_Click()
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("MASTER LIST").UsedRange.Rows.Count
J = Worksheets("VALIDATED LIST").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("VALIDATED LIST").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("MASTER LIST").Range("E1:E" & I)
On Error Resume Next
Application.ScreenUpdating = True
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = InStr(Worksheets("MASTER LIST").Range("E1:E" & I).Value, Worksheets("TRANSPOSED DATA NO SPACES").Range("B1:B" & J)) > 1 Then
xRg(K).EntireRow.Copy Destination:=Worksheets("VALIDATED LIST").Range("A" & J + 1)
J = J + 1
End If
Next
Application.ScreenUpdating = True
End Sub
Further Edit:
I want to be able to use the list of feature codes and look them up in the master list.
If the VBA code finds the feature code in the strings in the master list, then I need to copy the row and paste it into a blank sheet that will be called validated list.
Sub look_up_copy()
Dim last_row As Integer
Dim cell As Range
Dim Cells As Range
last_row = ThisWorkbook.Worksheets(2).Cells(ThisWorkbook.Worksheets(2).Rows.Count, "B").End(xlUp).Row
Set Cells = ThisWorkbook.Worksheets(2).Range("B1:B" & last_row)
For Each cell In Cells:
If cell.Value = ThisWorkbook.Worksheets(1).Range("A1").Value Then
cell.EntireRow.Copy
End If
Next cell
End Sub
You didn't say anything about wanting to paste, but if you do then just insert it after the copy line.
this should work, just remove duplicates on sheet3 after running. This is a double loop in which, for each cell in column B of sheet 2, the macro will check all values from sheet1 Column A. You will see duplicate lines in the end, but it doesn't matter right? all you need is remove dupes
Sub IvanAceRows()
Dim cell2 As Range, cells2 As Range, cell1 As Range, cells1 As Range
Dim lastrow2 As Long, lastrow1 As Long
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim i As Long, ii As Long, iii As Long
Set ws1 = Worksheets("USAGE CODES")
Set ws2 = Worksheets("MASTER LIST")
Set ws3 = Worksheets("VALIDATED LIST")
lastrow1 = ws1.cells(Rows.Count, 1).End(xlUp).Row
lastrow2 = ws2.cells(Rows.Count, 2).End(xlUp).Row
Set cells1 = ws1.Range("A1:A" & lastrow1)
Set cells2 = ws2.Range("B1:B" & lastrow2)
iii = 1
For ii = 1 To lastrow2
For i = 1 To lastrow1
If InStr(1, ws2.cells(ii, 2), ws1.cells(i, 1)) <> 0 Then
ws2.cells(ii, 2).EntireRow.Copy
ws3.Activate
ws3.cells(iii, 1).Select
Selection.PasteSpecial
iii = iii + 1
End If
Next i
Next ii
End Sub
Without seeing your spreadsheet, I assumed all of your 'codes' are listed in Column A in sheet1, and all of those code strings are also in sheet2 in column B. my code allows u to find each string from sheet1 in Column B of sheet2. Once found, it will be pasted into Sheet3 starting from the 2nd row.
Sub IvanfindsRow()
Dim i As Long
Dim lastrow1 As Long
Dim lastrow2 As Long
Dim Code As String
Dim search As Range
lastrow1 = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
lastrow2 = Worksheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Row
Worksheets("Sheet3").Range("A1").Select
For i = 1 To lastrow1
Code = Worksheets("Sheet1").Cells(i, 1).Value
Set search = Worksheets("Sheet2").Range("B1:B22").Find(what:=Code, lookat:=xlWhole)
If Not search Is Nothing Then
search.EntireRow.Copy
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial
Else 'do nothing
End If
Next i
Application.CutCopyMode = False
End Sub
Let's say i have the range of cells A1:C3 and i need to fill in any empty cells from the range with the value that is in cells A4:C4, the emplty cells in column A will be filled with the value of A4, those in column B with the value from B4 and so on.
This is dynamic by both Rows and Columns. The assumption is that the last row is the cell that will be used to fill in blanks. If the assumption is true, you can add rows and columns as you please and this code will work without any modification
Determine last row in range (Determined by Column A)
Determine last column (Determined by last row in step 1)
Loop through rows column by column
Fill blanks with the value associated with the last row if blank
Option Explicit
Sub Test()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") '<== Update Sheet Name
Dim LRow As Long, LCol As Long, r As Long, c As Long
LRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
LCol = ws.Cells(LRow, ws.Columns.Count).End(xlToLeft).Column
Application.ScreenUpdating = False
For c = 1 To LCol
For r = 1 To LRow - 1
If ws.Cells(r, c) = "" Then
ws.Cells(r, c).Value = ws.Cells(LRow, c).Value
End If
Next r
Next c
Application.ScreenUpdating = True
End Sub
Both examples below are from the same macro. Notice that it works as expected for your propsed example (4 Rows x 3 Columns) and for other table sizes like the example on right (8 Rows x 7 Columns)
If all the cells in A1:C3 are empty, then consider:
Sub FillInTheBlanks()
Range("A1:C3").Value = Range("A4:C4").Value
End Sub
If some of the cells in A1:C3 are not empty, then use:
Sub FillInTheBlanks2()
For i = 1 To 3
For j = 1 To 3
If Cells(i, j) = "" Then
Cells(4, j).Copy Cells(i, j)
End If
Next j
Next i
End Sub
You can try this.. just change Worksheets(1) to your desired Worksheet and 4 to desired row
Dim rng As Range
Dim cel As Range
With ThisWorkbook.Worksheets(1)
Set rng = .Range("A1:C3")
For each cel in rng
If Len(Trim(CStr(cel.Value))) = 0 Then cel.Value = .Cells(4, cel.Column).Value
Next
End With
I am new to VBA. Can anyone help me on this? I have 'return/enter' separated data in cell A2 & A3 and corresponding data in column B, C & D. Is it possible to get desired result as in the image using Excel VBA?
If you want your result to be in Sheet2, then this code will do what you expect, it will check the number of Columns on Sheet1 and copy all of them into Sheet2:
Sub foo()
Dim LastRow As Long
Dim LastCol As Long
Dim ws As Worksheet: Set ws = Sheets("Sheet1") 'change this to the name of your worksheet
Dim ws2 As Worksheet: Set ws2 = Sheets("Sheet2")
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row 'get the last row
LastCol = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column 'get the number of columns from row 2
For i = 2 To LastRow
strTest = ws.Cells(i, 1)
Myarray = Split(strTest, Chr(10)) 'split the values on the first column into an array
For x = LBound(Myarray) To UBound(Myarray) ' loop through array
LastRow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row 'get the last row of Sheet2
ws2.Cells(LastRow2 + 1, 1).Value = Myarray(x) 'paste the contents into Sheet2
For y = 2 To LastCol 'loop for the number of columns on Sheet1
ws2.Cells(LastRow2 + 1, y).Value = ws.Cells(i, y) 'paste all relevant columns into Sheet2
Next y
Next x
Next i
End Sub
I have an Excel workbook with two sheets: sheet1 has a large table of data in columns A to R, headers at row 1. Sheet2 has data in columns A to AO.
Using VBA I am trying to copy rows from sheet1 and paste them to the end of sheet2. Also I need to copy only columns A to R, not the entire row.
In other words, cells A2:R2 from sheet1 need to be copied to first AND second row that don't have data in column A.
I have the following code that copies the required cells from sheet1, but I cannot figure out how to copy every row twice:
Sub example()
For Each ce In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
If Not IsEmpty(ce) Then
Sheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 18).Value = Range(ce, ce.Offset(0, 17)).Value
End If
Next ce
End Sub
Try this:
Option Explicit
Sub CopyRows()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim i As Integer, k As Integer
Dim ws1LR As Long, ws2LR As Long
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
ws1LR = ws1.Range("A" & Rows.Count).End(xlUp).Row + 1
ws2LR = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1
i = 2
k = ws2LR
Do Until i = ws1LR
With ws1
.Range(.Cells(i, 1), .Cells(i, 18)).Copy
End With
With ws2
.Cells(k, 1).PasteSpecial
.Cells(k, 1).Offset(1, 0).PasteSpecial
End With
k = k + 2
i = i + 1
Loop
End Sub
Change Sheet1 and Sheet2 if they are called different things in your workbook.
I've seen similar posts, but nothing that has directly addressed my current problem...
I have a workbook with 2 sheets (Sheet1 and Sheet 2). In Sheet1, there are 2 columns - column A contains part numbers from our old ERP system and column B contains weights. In Sheet2, I have 2 columns - column A contains part numbers from our new ERP system and column B contains alias part numbers.
I would like to have a macro read in the part number in Sheet1 (which sits in column A) and see if that value exists in Sheet2 in either column A or column B. If it finds a match, it would need to copy the corresponding weight to column C on Sheet2.
I am a novice at writing macros and I've attached a modified version of code posted to a similar problem. Any help would be greatly appreciated - thank you in advance to any replies.
Sub CopyCells()
Application.ScreenUpdating = False
Dim sh1 As Worksheet, sh2 As Worksheet
Dim j As Long, i As Long, lastrow1 As Long, lastrow2 As Long
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
lastrow1 = sh1.Cells(Rows.Count, "A").End(xlUp).Row
lastrow2 = sh2.Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To lastrow1
For j = 2 To lastrow2
If sh1.Cells(i, "A").Value = sh2.Cells(j, "A").Value Or _
sh1.Cells(i, "A").Value = sh2.Cells(j, "B").Value Then
sh1.Cells(i, "B").Value = sh2.Cells(j, "C").Value
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub
This might help get you started. I am assuming you have data starting in row 1 in columns A and B of Sheet1 and Sheet2 and that you want to copy weights to Column C in Sheet2 :
Sub GetMatches()
Dim PartRngSheet1 As Range, PartRngSheet2 As Range
Dim lastRowSheet1 As Long, lastRowSheet2 As Long
Dim cl As Range, rng As Range
lastRowSheet1 = Worksheets("Sheet1").Range("A65536").End(xlUp).Row
Set PartRngSheet1 = Worksheets("Sheet1").Range("A1:A" & lastRowSheet1)
lastRowSheet2 = Worksheets("Sheet2").Range("B65536").End(xlUp).Row
Set PartRngSheet2 = Worksheets("Sheet2").Range("A1:A" & lastRowSheet2)
For Each cl In PartRngSheet1
For Each rng In PartRngSheet2
If (cl = rng) Or (cl = rng.Offset(0, 1)) Then
rng.Offset(0, 2) = cl.Offset(0, 1)
End If
Next rng
Next cl
End Sub