VBA checking for value (shell-ID) from Sheet1 and Sheet2.
So, I am a complete beginner to VBA. Yet, I have been trying to figure out the code for this using various internet sources. So my idea for this is that i have two sheets of data (say sheet1 and sheet2). Sheet1 is the master list and sheet2 has all the major data. Now, my main conditions are that if the Shell-ID of a specific row in sheet1 matches the Shell-ID in sheet2, then just update the phase of the project. But if the value does not exist, then copy other columns like name of the project, project description, phase of the project etc. for that corresponding shell-ID back into sheet1 from sheet2.
So far, I can only make the entire row copied onto the sheet but not specific parts that I require. Here is my code and what I have tried. Any help will be appreciated.
Edit: for some reason I cannot attach files to stack (dont know if its possible to be honest) but I have added the pictures for the sheet
Sub Copying()
'defining the variables
Dim sh1 As Worksheet, sh2 As Worksheet, lr As Long, fn As Range, sr As Range, rng As Range, n As Long
Dim i As Long, j As Long
Set sh1 = Sheet1
Set sh2 = Sheet2
Application.ScreenUpdating = False
'counting the number of rows in sheet 1
With Worksheets("Sheet1")
lr = .Cells(Rows.Count, 1).End(xlUp).Row + 1
End With
'gives you the number of rows
MsgBox ("Sheet1 has " & lr & "rows")
'counting rows for sheet2
With Worksheets("Sheet2")
j = .Cells(Rows.Count, 1).End(xlUp).Row
End With
'gives the number of rows for sheet2
MsgBox ("Sheet2 has " & j & "rows")
'checking the value from sheet2 vs sheet1 for shell ID #, if not present then it will copy the entire row
For i = 2 To j
With Worksheets("Sheet2")
If .Cells(i, 1).Value <>
Worksheets("Sheet1").Cells(i, 1).Value Then
.Rows(i).Copy
Destination:=Worksheets("Sheet1").Range("A" & lr)
lr = lr + 1
ElseIf .Cells(i, 1).Value =
Worksheets("Sheet1").Cells(i, 1).Value Then
End If
End With
Next i
MsgBox ("Copying complete")
End Sub
Related
How can I cycle through sheet1 to see if there is data in that cell?
If there is no data then go to the next cell.
If there is data in the next cell paste it into sheet2.
The criteria are:
I cannot use a set range it will change as the data changes in sheet1.
I can keep sheet names a constant such as sheet1 and sheet2.
I found a way using columns and or rows yet that code has a major issue. If there is no starting data in the first cell it will not copy anything in the entire row and or column.
I am posting the code I worked with to check the data in columns but if there is no starting data it will skip the whole row.
Sub CopytoImport()
Dim wb As Workbook
Dim iCol As Long
Dim ws As Worksheet
Sheets("sheet2").Cells.ClearContents
' Loop through the column
For iCol = 1 To 22 ' Call out columns I cannot set this every time it should look threw all cells
With Worksheets("sheet1").Columns(iCol)
' Check tht column is not empty
If .Cells(1, 1).Value = "" Then
'Nothing in this column
'Do nothing
Else
' Copy the coumn to te destination
Range(.Cells(1, 1), .End(xlDown)).Copy _
Destination:=Worksheets("sheet2").Columns(iCol).Cells(1, 1)
End If
End With
Next iCol
ActiveWorkbook.Save
End Sub
Function runcode()
Call CopytoImport
End Function
Cells(1, 1) is just RANGE.("A1") you are only operating on this cell in your code. You would need Cells(1, iCol) to account for what column you are on during your loop.
You might also need a nested loop since you are looping through rows as well. The basic outline of a nested loop is as follows. Note the Cells(1,1) is replaced with the i and j representing what row and what column we are on. This might not be the fastest way to achieve the results you want but it sounds like this is what you are asking for help with. You will also need to define a lastrow (with a + 1 at the end to get the next blank cell) in your Sheet2 for when you paste the data. You would put this right under where the loop starts going through rows. This is so the lastrow of your sheet2 is recalculated each time data is being moved to that sheet. I am not going to re-write your code since you stated it is not complete but here is an example that should help you.
For j = 5 To lastcolumn
For i = 5 To lastrow
Dim lastrow2 As Long
lastrow2 = Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1
If Worksheets(2).Cells(i, j).Value <> 0 Then
Worksheets(1).Range("C" & lastrow2).Value = Worksheets(2).Cells(i, j).Value
Worksheets(1).Range("B" & lastrow2).Value = Worksheets(2).Cells(2, j).Value
End If
Next i
Next j
To find your lastrow:
dim lastrow as long
lastrow = Range("A" & rows.count).End(xlup).Row ' or whatever column contains the data
To find your last column
Dim lastcolumn As Long
lastcolumn = Worksheets(2).Cells(2, Columns.Count).End(xlToLeft).Column
I have two questions
How to combine data using two of the cells from workbookA and copy to workbookB on the same cell?
How do I start using for loop to copy it until the last row/column?
I have no clue on how to combine the data and I do not know where to place the variable inside the code for it to loop until its last column.
Dim Tlastrow As Integer
Tlastrow = Cells(1, Columns.Count).End(xlToLeft).Column
For r = 1 To Tlastrow
Workbooks("InputB.xls").Worksheets("HC_MODULAR_BOARD_20180112").Range("F3:G3").Copy _
Workbooks("Output.xls").Worksheets("Sheet1").Range("I3")
Next
Try this:
Option Explicit
Sub Paste()
Dim wsInput As Worksheet, wsOutput As Worksheet, LastRow As Long, C As Range
Set wsInput = Workbooks("InputB.xls").Worksheets("HC_MODULAR_BOARD_20180112")
Set wsOutput = Workbooks("Output.xls").Worksheets("Sheet1")
With wsInput
LastRow = .Cells(.Rows.Count, "E").End(xlUp).Row 'Last Row with data
For Each C In .Range("F3:F" & LastRow) 'loop for every row with data
wsOutput.Cells(C.Row, "I").Value = C & " " & C.Offset(0, 1)
Next C
End With
End Sub
This code is assuming you want to paste every row from your input workbook to the output workbook on the same rows, but merging F and G columns. It's just pasting the values, not formulas or formats.
Hoping you can help, please!
So I have 2 worksheets, 1 & 2. Sheet1 has already existing data, Sheet2 is used to dump raw data into. This is updated daily, and the data dump includes both data from previous days, as well as new data. The new data may include rows relating to interactions that may have happened earlier in the month, not just the previous day. So the data is not "date sequential".
There are 9 columns of data, with a unique identifier in column I.
What I'm needing to happen is when running the macro, it looks in column I in Sheet1 and Sheet2, and only copies and pastes rows where the unique identifier in Sheet 2 doesn't already exist in Sheet1. And pastes them from the last empty row onwards in Sheet1.
What I currently have is this - it's all I could find online:
Sub CopyData()
Application.ScreenUpdating = False
Dim LastRow As Long
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim rng As Range
Dim foundVal As Range
For Each rng In Sheets("Sheet2").Range("A1:I" & LastRow)
Set foundVal = Sheets("Sheet1").Range("I:I").Find(rng, LookIn:=xlValues, LookAt:=xlWhole)
If foundVal Is Nothing Then
rng.EntireRow.Copy Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
Next rng
Application.ScreenUpdating = True
End Sub
But it's just not working - not only does it not recognise if the value in column I already exists, it's copying and pasting only the first 2 rows from Sheet2, but duplicating them 8 times each!
Apologies in advance, I'm a real VBA novice, and just can't work out where it's all going wrong. I would appreciate any assistance!
This will do what you want:
Sub testy()
Dim wks As Worksheet, base As Worksheet
Dim n As Long, i As Long, m As Long
Dim rng As Range
Set wks = ThisWorkbook.Worksheets(2) 'Change "2" with your input sheet name
Set base = ThisWorkbook.Worksheets(1) 'Change "1" with your output sheet name
n = base.Cells(base.Rows.Count, "A").End(xlUp).Row
m = wks.Cells(wks.Rows.Count, "A").End(xlUp).Row
For i = 2 To m
On Error Resume Next
If IsError(WorksheetFunction.Match(wks.Cells(i, 9), base.Range("I:I"), 0)) Then
Set rng = wks.Cells(i, 1).Resize(1, 9) 'Change 9 with your input range column count
n = n + 1
base.Cells(n, 1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
End If
Next i
End Sub
I found this Excel VBA code that's very short and clean and it does its job to copy the entire row based on a condition. I added it to my vba project and it works well the only problem is - it copies the entire row.
I am trying to implement the code to only copy rows from Column E to K, but
I have not been successful in tweaking the code to what I am trying to do.
Basically, in worksheet "verification" if Column "AB" = "Final" then copy each row that has "Final" from Column E to K to the worksheet "upload".
I am pulling my hair to make it work, and I have search everywehre and no luck. I know in this platform, I can find the solution to my problem.
I will keep on playing with the code.
Sub CopyEachRowtoUpload()
Application.ScreenUpdating = False
Dim wsI As Worksheet, wsO As Worksheet
Dim LastRow As Long, i As Long, j As Long
Dim LastColumn As Long, a As Long, b As Long
Dim rng As Range
Set wsI = Sheets("Verification")
Set wsO = Sheets("Upload")
Set rng = wsI.Range("E:K")
'Last Row in a Column. Row need to start in row 2
LastRow = wsI.Cells(Rows.Count, "K").End(xlUp).Row
'Last Column in a Row. Rows from Column E to K is what I want to copy
LastColumn = wsI.Cells(5, Columns.Count).End(xlToLeft).Column
'Row start
j = 2
With wsI
'Loop through each row
For i = 1 To LastRow
If Range("AB" & i).Value = "Final" Then
wsI.Rows(i).Copy
wsO.Rows(j).PasteSpecial Paste:=xlPasteValues
j = j + 1
End If
Next i
End With
Application.ScreenUpdating = True
End Sub
Just use the Range.Cells property together with the Range.Resize property to locate and shape the source and target.
With wsI
'Loop through each row
For i = 1 To LastRow
If .Range("AB" & i).Value = "Final" Then
wsO.Cells(j, "A").Resize(1, 7) = .Cells(i, "E").Resize(1, 7).Value
j = j + 1
End If
Next i
End With
Direct value transfer is preferred over Copy, Paste Special, Values if all you want is the cell values.
btw, you were missing a . in .Range("AB" & i).Value.
I realize there are a few different similar ideas on here. But I need help with this simple compare function.
My goal is to compare two different cells and if they are the same, replace it with its full non-abbreviated name.
Thank you for your time!!!
I.E
Sheet1 Sheet2
Column H Column A Column B
Dept Dept Department
This is what I have (Yes simple), but the cell H is not updating to the non-abbreviation:
Sub updateDeptNames()
'Format user ID from the email column
Dim ws As Worksheet, ws2 As Worksheet
Dim LastRow As Long, i As Long
Dim tmpArray() As String, tempDept As String
Set ws = ActiveWorkbook.Sheets("Student_Travel_DB") '--> This is the relevant sheet
Set ws2 = ActiveWorkbook.Sheets("gokoutd") '--> This is the relevant sheet
LastRow = 1000 ''Bug finding the last row, had to hard code it
For i = 2 To LastRow 'Iterate through all the rows in the sheet
For j = 2 To 112
tempDept = ws2.Range("A" & j).Value
If ws.Range("H" & i).Value = tempDept Then
ws.Range("H" & i) = ws2.Range("B" & j).Value
End If
Next j
Next i
End Sub
You can more easily use VLOOKUP either on your worksheet or with VBA:
Sub GetFullName()
Dim cl As Range, data As Range, lookUpRng As Range
Set data = Worksheets("Student_Travel_DB").Range("A1:A10")
Set lookUpRng = Worksheets("gokoutd").Range("A1:B10")
On Error Resume Next
For Each cl In data
cl = WorksheetFunction.VLookup(cl, lookUpRng, 2, False)
Next cl
End Sub
You'll need to change your range references.