VBA Copying cells to another worksheet where cells have the same value - vba

I have two worksheets I'm working with with long serial numbers as the cell values. One sheet (Sheet1) has a list of each individual serial number hyperlinked to a webpage referring to that item. This list ranges from A1:A31.
The second sheet (Sheet2) has a massive list of those same serial numbers, but in range G1:G102. The difference is that this list is not hyperlinked, and the serial numbers sometimes show up multiple times. There are also some areas where a cell is blank, so it splits up the continuous column of data.
I would essentially like to write a macro that takes the first list in Sheet1, and for each cell, it compares it to each cell in Sheet2 column G. Then, if the values match, I would like to copy the hyperlinked cell from Sheet 1 and paste it to that cell with the same value in Sheet2. Therefore, Sheet2 column G now has a fully populated list of hyperlinked serial numbers.
Can anyone help me with this? This is what I have so far...doesn't seem to work:
Sub CopyHyperlinks()
Dim cell As Excel.Range
Dim myRange As Excel.Range
Dim newRange As Excel.Range
Set myRange = Excel.ThisWorkbook.Sheets("Contents").Range("A1:A31")
Set newRange = Excel.ThisWorkbook.Sheets("Sheet1").Range("G1:G102")
For Each cell In myRange
If myRange.Cells.Value = newRange.Cells.Value Then newRange.Cells.Value = myRange.Cells.Value
Next cell
End Sub'

See this little function. Put this:
Function GetHyperLinkAddress(rng As Range) As String
Dim hl As Hyperlink
For Each hl In rng.Parent.Hyperlinks
If hl.Range.Address = rng.Address Then
GetHyperLinkAddress = hl.Address
Exit Function
End If
Next hl
GetHyperLinkAddress = "Not Found"
End Function
in a module. In the Spreadsheet, add
=GetHyperLinkAddress(Cell#)
Next to the cells with the hyperlink. You could then just use a vlookup to match.

Related

Find a sheet based on a cell name, then find the entry based on a different cell name, and fill in the values from adjacent cells

I'm pretty new to VBA, I've got a spread sheet that has a list of vehicle ID's in a row of columns, and different identifiers (ID) in column A.
So far I'm able to search for the sheet with the vehicle name and copy a range of cells to the main sheet. I'm trying to make it so that once it finds the specific vehicle sheet, it looks for the specific ID and pulls that in, rather than copy a set range of cells. I'm having it return nothing now, and when I had it before excel would crash, so I assumed I was in some sort of endless loop.
Dim ws As Worksheet, sh As Worksheet
Dim Rng As Range, c As Range
Dim ECU_Ovv As Range, ECU_V As Range
Set ws = Sheets("Overview") 'main worksheet to copy everything to
Set Rng = ws.Cells(3, 3).Resize(3, LastColumn) ' I;ve calculated LastColumn earlier, it's defined as a Long
Set ECU_Ovv = ws.Cells(5, 2).Resize(LastRow, 2)
For Each sh In Sheets
For Each c In Rng.Cells
If sh.Name = c Then
'Find row range for specific vehicle
LastRow = sh.Cells(Rows.Count, 2).End(xlUp).Row
Set ECU_V = sh.Cells(5, 2).Resize(LastRow, 2) ' this is the only syntax I could figure out to get it to let me set a range with a calculated variable
For Each ECU_Ovv In ECU_V.Cells 'now look for the ID in the specific sheet
If ECU_Ovv.Cells = ECU_V.Cells Then
a = ECU_Ovv.Value 'Put this here to see if I am able to match ID's from the main sheet to the specific sheet
'sh.Range("D12:D47").Copy Destination:=ws.Cells(24, c.Column) 'this was working but it's hardcoded so any change in the sheets would break it
End If
Next ECU_Ovv
End If
Next c
Next sh
I'm planning on adding a copy cell, 2 columns over (from the found ID) to the column of the vehicle (Rng), but I'll cross that bridge when I get there!

Excel Database data issue

I have a farily large database of around 2000 people, sheet1 has all of their names and relevant details. Sheet 2 has data pulled on from a site. I would like the data from sheet 2 to auto populate the cells in Sheet 1. Also if the person does not exist in sheet1 to highlight the data it couldnt do. I am so stuck on this.
Sub dup()
Dim cell As Range, cella As Range, rng As Range, srng As Range
Set rng2 = Sheets(2).Range("A2:E2000")
Set rng3 = Sheets(3).Range("A2:E29000")
For Each cell In rng2
For Each cella In rng3
If cella = cell Then
cella.Interior.ColorIndex = 6
' cella.AddComment.Text Text:="duplicate value"
End If
Next cella
Next cell
Set rng2 = Sheets(2).Range("T2:Y2000")
Set rng4 = Sheets(4).Range("A1:F2000")
For Each cell In rng2
For Each cella In rng4
If cella = cell Then
cella.Interior.ColorIndex = 6
' cella.AddComment.Text Text:="duplicate value"
End If
Next cella
Next cell
End Sub
Its hard for me to show as it has a lot of columns not sure how on earth i can show you what im trying to do? :(
Try https://filetea.me/t1sfGPWECvdQqmgVDGtXL4oRQ
Maybe, if you want to do it without vba, you could use the LOOKUP function in the sheet 1's auto populate column. It works like that:
=LOOKUP(sheet1!A2, sheet2!table[a], sheet2!table[b])
This will find the value in the column "b" of the table in sheet2 based on the values of column "a". This will chose the value in the same row were column "a" matches the value in sheet1's A column. Let me know if I wasn't clear enough here.
Then you can use Conditional Formatting rules for the highlight you said. I suggest the COUNTIF function, that will return 0 if no matching value is found in the specified range.
=COUNTIF(A2:A5,A4)
This, for example, cont values in A2:A5 that matches the values in A4.
Also, you will find the conditional formatting tools in the home tab, if you are using excel 2016.
See the link for more information:
Information you may need

Highlight unique values based on another range

Column 1 is in Sheet1 and column 2 is in Sheet2. If the value is not found , then highlight that cell. I am trying to do a vlookup comparing two columns. I think the Syntax is incorrect. Please see my code I was trying below:
Option Explicit
Sub VlookupColoums()
' declarations
Dim lookFor As Range
Dim srchRange As Range
Dim I As Long
Dim vtest As Variant
' start
Set lookFor = Sheets("Sheet1").Range("A13").End(xlUp)
Set srchRange = Sheets("Sheet2").Range("A2").End(xlUp)
vtest = Application.VLookup(lookFor.Rows.Count, srchRange.Rows.Count, 2, False)
' process
For I = 1 To lookFor.Rows.Count
If IsError(vtest) Then
srchRange.Interior.Color = 4
Else
Exit Sub
End If
Next I
End Sub
Assuming you have data on Sheet1!A1:A15 and Sheet2!A1:A10.
Also assuming you want to highlight unique cells (ones withouth at least one identical in the other list) on Sheet2.
Basically you want to format all the cells that if counted on the other list comes up with 0. The steps:
Select all the cells to be evaluated on Sheet2
Go to Home/Styles/Conditional Formatting
Select New Rule, then Use a formula to determine...
Enter this formula: =COUNTIF(Sheet1!$A$1:$A$5,A1)=0
Click on the Format button, and set up a formatting for the unique cells
OK
Profit. :)

Excel Range Reference

Let me preface this question by saying I am not super technical so much of my verbiage may seem obscure..
On sheet1 I have three seperate horizontal ranges of cells (3 seperate series of steps):
A1:D1
A2:C2
A3:E3
On sheet two, I'd like to link to create live links to these ranges, such that if I change information on sheet1, it will be automatically reflected in sheet2.
The catch is, that on sheet2, I want the ranges to be listed after one another in one row, to create one long series of steps.
Range1-->Range2-->Range3 (all on one row)
How do I ensure that if I add an additional step to, say, the first range on sheet1, that on sheet 2, the new cell will be added and the following cells will all be pushed over to the right by one cell?
To accommodate ranges that might grow, start from the first cell and then find the last occupied cell with End(xlToRight). Once you've found all the range extents, you can combine them with an array UDF:
Function ConcatRanges(ParamArray ranges()) As Variant()
Application.Volatile
Dim ret() As Variant
ReDim ret(1 To 1, 1 To (Application.Caller.Columns.Count))
Dim RetIdx&, i&, cell As Range
RetIdx = 1
For i = 0 To UBound(ranges)
For Each cell in Application.Range(ranges(i), ranges(i).End(xlToRight))
ret(1, RetIdx) = cell.Value
RetIdx = RetIdx + 1
Next
Next
For RetIdx = RetIdx To UBound(ret, 2)
ret(1, RetIdx) = vbNullString
Next
ConcatRanges = ret
End Function
For your example, you'd call it like this:
=ConcatRanges(Sheet1!A1, Sheet1!A2, Sheet1!A3)

Copy/Paste cells next to cells that have certain string

I am trying to look up cells in a certain column that have a string (e.g. Names), copy the corresponding cells in the column to its right (i.e. offset(0,1) ), then paste it to a column in a different sheet. I have the following code to find the range variable that I want. However, I can't select it from a different sheet!
When I use Sheets(1).MyRange.Copy, it doesn't accept it. Am I referring to the range in a wrong way? What am I doing wrong?
Here's code that I use to get MyRange:
Option Explicit
Sub SelectByValue(Rng1 As Range, Value As Double)
Dim MyRange As Range
Dim Cell As Object
'Check every cell in the range for matching criteria.
For Each Cell In Rng1
If Cell.Value = Value Then
If MyRange Is Nothing Then
Set MyRange = Range(Cell.Address)
Else
Set MyRange = Union(MyRange, Range(Cell.Address))
End If
End If
Next
End Sub
Sub CallSelectByValue()
'Call the macro and pass all the required variables to it.
'In the line below, change the Range, Minimum Value, and Maximum Value as needed
Call SelectByValue(Sheets(1).Range("A1:A20"), "Tom")
End Sub
One More Question: Rather than specifying the exact range to look at (e.g. "A1:A20"), I would LOVE to look at all of column A. But I don't want to use ("A:A") so it wouldn't look at all rows of A. Isn't there a method to look only in cells that have entries in column A?
Thank you VERY much.
Al
You only need MyRange.Copy.
To restrict only to cells in column A which might have values, you could use
With Sheet1
Set rngToSearch = Application.Intersect(.Columns(1), .UsedRange)
End With
...or maybe look at .SpecialsCells()