I have been trying to approach a particular case, but have yet to know where to go from what I have so far. Any help would be greatly appreciated.
I found something which I wanted to try to see if I could build from it to my particular case here. I copied the contents from file2 to sheet3 instead of using two separate files to see if this too could work. But, after changing values around, I still got an error(Run time error 9. Subscript out of range)
Originally, I have two excel files.
File1 has item Names in columnE starting after A5 in sheet2.
File2 has item Names in columnA starting after A3 in sheet1.
I want to write a macro that can place a number(Barcode) into ColumnD in file2, found from ColumnD in File1, for each cell value in ColumnA from file2 that matches cell value in ColumnE from file1.
In other words, File2 with item names in columnA that have no bar code in columnD, search list of all items in File1 ColumnE, find exact name match, from that same row copy value of column D containing barcode, paste barcode value into File2 empty columnD.
Sub Find_Barcode()
Dim PartRngSheet1 As Range, PartRngSheet2 As Range
Dim lastRowSheet1 As Long, lastRowSheet2 As Long
Dim cl As Range, rng As Range
lastRowSheet1 = Worksheets("Sheet2").Range("E65536").End(xlUp).Row
Set PartRngSheet1 = Worksheets("Sheet2").Range("A1:A" & lastRowSheet1)
lastRowSheet2 = Worksheets("Sheet3").Range("A65536").End(xlUp).Row
Set PartRngSheet2 = Worksheets("Sheet3").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, 4) = cl.Offset(0, 1)
End If
Next rng
Next cl
End Sub
Try below code :
Assuming File1 & File2 are two different workbooks and are open.
Sub Find_Barcode()
Dim lastRow As Long, rngFind As Range, rngFound As Range
lastRow = Workbooks("File2").Sheets("sheet1").Range("A65000").End(xlUp).Row
Workbooks("File1").Activate
Set rngFind = Workbooks("File1").Sheets("sheet2").Range("E5", Range("E65000").End(xlUp).Row)
For i = 3 To lastRow
Set rngFound = rngFind.Find(what:=Workbooks("File2").Sheets("sheet1").Cells(i, 1))
If Not rngFound Is Nothing Then
rngFound.Offset(0, -1).Copy Workbooks("File2").Sheets("sheet1").Cells(i, 4)
End If
Next
End Sub
Related
I have a worksheet that contains a varying amount of Rows of data in Column A , within this worksheet I need to search for a specific string then copy the data contained in the Cell adjacent to it and paste into Column C, i.e if data was found in A2 then i need to copy the data from B2 and paste into C1. I can easily find and copy when the string appears once but the string will appear more than once 100% of time. here is when i run into issues.
The temporary code I have written for ease of understanding, searches the spreadsheet for the last Mention of A, get the row number, copy the B cell for that row number then pastes the value into C1.
I guess you need to use range variables for this but not 100% sure how to do it.
i have found no way to copy all mentions of A into a column, or ideally sum up the contents of the B cells. (I can do this, just long winded)
Ive placed my code below.
Sub ValueFinder()
Dim LastALocation As String
Dim ValueContent As String
LastALocation = Range("A:A").Find(What:="A", after:=Range("A1"), searchdirection:=xlPrevious).Row
ValueContent = Cells(LastALocation, 2)
Cells(1, 3) = ValueContent
End Sub
The spreadsheet that its using for more information, contains A,B,C on a loop in Column A and the odd numbers in Column B.
Thanks for any help your able to provide.
Mark
This will look for a string in Column A, and add to Column C the same row's B Column Value.
Sub find_move()
Dim foundCel As Range
Dim findStr As String, firstAddress As String
Dim i As Long
i = 1
findStr = "A"
Set foundCel = Range("A:A").Find(what:=findStr)
If Not foundCel Is Nothing Then
firstAddress = foundCel.Address
Do
Range("C" & i).Value = foundCel.Offset(0, 1).Value
Set foundCel = Range("A:A").FindNext(foundCel)
i = i + 1
Loop While Not foundCel Is Nothing And foundCel.Address <> firstAddress
End If
End Sub
Note: You should add the worksheet in front of all the range values, i.e. Sheets("Sheet1").Range("A:A").Find(...
Consider:
Sub LookingForA()
Dim s As String, rng As Range, WhichRows() As Long
Dim rFound As Range
ReDim WhichRows(1)
s = "A"
Set rng = Range("A:A")
Set rFound = rng.Find(What:=s, After:=rng(1))
WhichRows(1) = rFound.Row
Cells(1, 3) = Cells(rFound.Row, 2)
Do
Set rFound = rng.FindNext(After:=rFound)
If rFound.Row = WhichRows(1) Then Exit Do
ReDim Preserve WhichRows(UBound(WhichRows) + 1)
WhichRows(UBound(WhichRows)) = rFound.Row
Cells(Cells(Rows.Count, "C").End(xlUp).Row + 1, 3) = Cells(rFound.Row, 2)
Loop
End Sub
This code builds column C. It also builds an internal array of the row numbers in the event they are needed later.
EDIT#1:
To read about dynamic arrays:
Dynamic Arrays
or Google:
Excel VBA dynamic array
I'm begginer in VBA and looking for a solution to check something in a table. I would like to create a function that tells if cells in a certain column (range) is not empty only then if the cell in the title column (range) equals something. I tried with a combination of isempty and vlookup but it didn't work.
I hope the description is clear, anyway I attached a simplified table with the problem. Thank you in advance!
enter image description here
Not sure i have understood your problem 100% but lets begin with what i think i understood, and start with the below:
Sub isitEmpty()
With Sheets("Sheet1")
If IsEmpty(.Range("B1:E2")).Value Then
'do something
Else
'do something
End If
End With
End Sub
What do you want to do if the cell is/isnot empty?
Below code works with following assumptions:
Project Type are listed in Column A starting from Cell A4
A,B,C,D category could vary but will always have headings in Row 3
Project Type for which you want the participation as Y, are listed in a column that appear after the last column with headings A,B,C,D. So as per your image its Column F
Sub Demo()
Dim ws As Worksheet
Dim lRProject As Long, lRMatch As Long, lastColumn As Long, i As Long
Dim rngProject As Range, celPro As Range, rngMatch As Range, celMatch As Range
Set ws = ThisWorkbook.Sheets("Sheet5") 'change to your sheet
With ws
lastColumn = .Cells(3, Columns.count).End(xlToLeft).Column 'gives last column with A,B,C,D
lRProject = .Cells(.Rows.count, "A").End(xlUp).Row 'last row in Column A
lRMatch = .Cells(.Rows.count, lastColumn + 1).End(xlUp).Row 'last row in Column F
Set rngMatch = .Range(.Cells(1, lastColumn + 1), .Cells(lRMatch, lastColumn + 1))
Set rngProject = .Range("A4:A" & lRProject)
For Each celMatch In rngMatch
For Each celPro In rngProject
For i = 2 To lastColumn
If celPro.Value = celMatch Then
If .Cells(celPro.Row, i) = "X" Then
.Cells(celMatch.Row, i) = "Y"
End If
End If
Next i
Next celPro
Next celMatch
End With
End Sub
See image for reference.
I have data in column A of three sheets. I have to take one sheet's data and have to compare with the remaining two sheets' data.
Can anybody help me?
Without more context/information, I can only give you a high-level response but hopefully it can get you started.
To check if items in one range are found in another range, the code below builds a string from one range then uses "Instr" to compare each item from another range against it. To do more sophisticated comparisons, I'd build arrays from the ranges.
Sub CompareLists()
Dim rng1 As Range, rng2 As Range
Dim cell As Range
Dim tmp As String
Set rng1 = Worksheets("Sheet1").Range("A1:A6")
Set rng2 = Worksheets("Sheet2").Range("A1:A6")
'Build pipe-delimited string from cells in range
For Each cell In rng1
tmp = tmp & cell & "|"
Next cell
'Remove last pipe
tmp = Left(tmp, Len(tmp) - 1)
'Loop list 2 and compare against list 1.
'Specifically, see if each item in list 2 is found in list 1
For Each cell In rng2
If InStr(1, tmp, cell) > 0 Then
'Print items from list 2 that are found in list 1
Debug.Print "Found: " & cell.Value
Else
'Print items from list 2 that are NOT found in list 1
Debug.Print "NOT Found: " & cell.Value
End If
Next cell
Set rng1 = Nothing
Set rng2 = Nothing
Set cell = Nothing
End Sub
As the title implies, I have a large dataset. Column B contains a list of numbers. In each row, there is a number of cells containing an amalgamation of text. Some are twenty cells long, with random names and country names throughout. I want to write a script to pull out whatever country appears in each, and paste them into column A.
The pseudo, unworking script I have so far is:
Sub PullCountries()
Dim Rng As Range
Dim i As Long
i = 1
Dim LastRow As Long
LastRow = Range("B1").End(xlDown).Row
While i <= LastRow
Set Rng = Range("B" & i)
If Application.WorksheetFunction.CountIf(Range(Row(i:i), "United States") Then 'this doesn't work at the moment for triggering when these words appear
"United States".Copy 'not sure how to be specific here
Rng.Offset(0, -1).paste special
ElseIf Application.WorksheetFunction.CountIf(Range(Row(i:i), "Canada") Then
"Canada".Copy
Rng.Offset(0, -1).paste special
'My plan was to write a line for the countries that appear most common, then carry out the rest manually.
Else: i + i = 1
End If
Wend
End Sub
Obviously, the line "United States".Copy doesn't work, and (Row(i:i)) is bringing up an error.
Does anyone have any idea how to make this work?
My suggestion would be to use the FindAll method. This gives an overview.
Dim SearchRange As Range, FindWhat As Variant, FoundCells As Range, FoundCell As Range
FindWhat = Array("Country1","Country2","Country3",etc)
Set SearchRange = ActiveSheet.Range("B:B")
For s = LBound(FindWhat) to UBound(FindWhat)
Set FoundCells = FindAll(SearchRange:=SearchRange, FindWhat:=FindWhat(s), LookIn:=xlValues,LookAt:=xlWhole, MatchCase:=False)
If Not FoundCells Is Nothing Then
For each FoundCell In FoundCells
FoundCell.Offset(,-1).Value = FoundCell.Value
Next
End If
Next s
The code I wrote above will loop through the column B looking for each value/country name you provide in the array FindWhat. For each instance that it finds of a country it will paste the country into columnA on the same row. Let me know if you wanted to paste it at the first open/top of column A instead of on the same row each value was found and I'll adjust the code accordingly. It wasn't clear to me which of the two you wanted. I hope this helps.
I have a row of data that changes once a month but it only changes roughly 30 cells out of 90 and every month they are different so I am trying to make a Macro to automate it.
The Macro looks at Cells A2 - B98 and searches for information that matches the Values of H2-I98 and if the values in A match H then it copies what the value is in I and replaces it in B but it doest stop at the end of the row i.e. at row 98 it loops infinatly. So I was hoping someone could find my error so that it wont loop for ever. Thanks
Sub Update_Holiday()
Dim Search As String
Dim Replacement As String
Dim rngTmp As Range
Dim rngSearch As Range
LastInputRow = Range("A65536").End(xlUp).Row
Set rngSearch = Worksheets("Holiday").Range(Cells(2, 1), Cells(98, 2))
For k = 2 to 98
Search = Worksheets("Holiday").Cells(k, 8)
Replacement = Worksheets("Holiday").Cells(k, 9)
With rngSearch
Set rngTmp = .Find(Search, LookIn:=xlValues)
If rngTmp Is Nothing Then
GoTo Go_to_next_input_row:
Else
Worksheets("Holiday").Cells(rngTmp.Row, rngTmp.Column + 1).Value = Replacement
End If
End With
Go_to_next_input_row:
Next K
End Sub
If I understand your question correctly: for each Cell in H2:H98, you're looking for a match in A2:A98. It won't necessarily be on the same row. If you find a match in Column A, you want to take the value from Column B and put it in Column I on the same row as the search value we just looked for. In this case, this code will work:
Option Explicit
Sub Test()
Dim ws As Worksheet
Dim srcRng As Range '' Source range
Dim schRng As Range '' Search range
Dim c As Range
Dim search As Range
Set ws = ThisWorkbook.Sheets(1)
Set srcRng = ws.Range("H2:H98")
Set schRng = ws.Range("A2:A98")
For Each c In srcRng '' Iterate through your source range
Set search = schRng.Find(c.Value, LookIn:=xlValues, SearchDirection:=xlNext) '' Find the value from column H in column A
If Not search Is Nothing Then
c.Offset(, 1).Copy search.Offset(, 1) '' Get the value from column B, from the same row as the value it found in column A
'' Then paste that value in column I, on the same row as the value we searched for from column H
End If
Next c
GoTo statements are generally (generally, not always) very, very bad practice. Especially in this kind of situation. You don't need them, it just makes your code convoluted.