Matching/replacing cell data with hyperlinks from another cell - vba

Question

I am doing a lot of manual work and I tried finding relevant macros, but unfortunately could not find any.
Basically, my Excel sheet has 4 columns (A, B, C, D). I am left with data in columns A and B after doing a lot of screening on the current month's company filings (I remove certain marcaps above and below my range, I remove data not relevant to not my sector, etc.).
Column A has the company name (upper case, lower case and sometimes combination)
Column B has the date (I am doing by month now)
Once these 2 columns are ready, I run a web query from website, which downloads the entire month's filings with SEC with hyperlinks.
Column C has the Company Name with HYPERLINKS (not necessarily same case formatting as in Col A)
Column D has the Date (I am downloading monthly, so that will be the same month)
Column C has data that is much more than Col A; it has all the unwanted companies' hyperlinks too and there is no way that the search on that website can be more customized than to the extent it currently is.
Col D is much longer than Col B, because of more filings
e.g.:
Col A Col B Col C Col D
(Hyperlinks)
Abc 3/1/2008 AAA 3/1/2008
BCD 3/1/2008 AAB 3/1/2008
BCD 3/2/2008 AAC 3/1/2008
cDE 3/2/2008 ABC 3/1/2008
DeF 3/3/2008 ABE 3/1/2008
BCD 3/1/2008
ABC 3/2/2008
BCD 3/2/2008
CDE 3/2/2008
AAA 3/3/2008
AAF 3/3/2008
DEF 3/3/2008
I need the company in Col C to replace Col A with its Hyperlink, provided they are on the same date (Col B=Col D), irrespective of case (company names are unique).
The order of the companies in Col A and C are not same, even if I sort 'A-Z' for these columns, because of unwanted companies' data in Col C. C is a much longer column than A.
Each month has 1200 to 1500 filings and I am checking manually and replacing manually date-wise. I have to do this for 3 years, I am still in the same month for past 10 days. There is still more: I have to open each filing and read through and update the remarks column.

Answer 1

I believe the code below does what you seek.
I created this worksheet to match your image:
The macro below changes the worksheet to:
Columns C and D are now redundent since every value in those columns has been moved to column F and G.
Hope this helps.
Edit
Meena ran the macro against her data but it did not match all the values that should have been matched. She emailed me a copy of her data. Having examined her data, I have made three changes to the macro below:
Meena's worksheet has no heading row. I use a constant to specify the first data row. I have changed the value from 2 to 1.
Many of the reference values have trailing spaces. I have used TRIM() to remove those trailing spaces before the comparisons.
The macro creates two new columns of data. These were left at the default width so if the value was long, it would wrap and require several lines. I have now added code to copy the the column widths from the source columns to the destination columns.
.
Option Explicit
' If the columns have to be moved, update these constants
' and the code will change to match.
Const ColRefCompany As Long = 1
Const ColRefDate As Long = 2
Const ColWebCompany As Long = 3
Const ColWebDate As Long = 4
Const ColSaveCompany As Long = 6
Const ColSaveDate As Long = 7
Const ColLastLoad As Long = 4
Const RowDataFirst As Long = 1 ' No header row
Sub CopyWebValuestoSaveColumns()
Dim CellValue() As Variant
Dim ColCrnt As Long
Dim Rng As Range
Dim RowRefCrnt As Long
Dim RowSave() As Long
Dim RowSaveCrnt As Long
Dim RowWebCrnt As Long
Dim RowLast As Long
' Find the last cell with a value
With Worksheets("Sheet1")
Set Rng = .Cells.Find(What:="*", After:=.Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)
If Rng Is Nothing Then
Call MsgBox("Sheet is empty", vbOKOnly)
Exit Sub
End If
RowLast = Rng.Row
' Load all reference and web values to CellValue. Searching an array
' is faster than searching the worksheet and hyperlinks are converted
' to their display values which gives an easier comparison.
' Note for arrays loaded from a worksheet, dimension one is for rows
' and dimension two is for columns.
CellValue = .Range(.Cells(1, 1), .Cells(RowLast, ColLastLoad)).Value
' RowSave() will record the position in the save columns of the values
' in the web columns. Allow for one entry per row in web list.
ReDim RowSave(1 To RowLast)
RowRefCrnt = RowDataFirst
' Set web company names to lower case and remove leading and trailing
' spaces ready for matching
For RowWebCrnt = RowDataFirst To RowLast
CellValue(RowWebCrnt, ColWebCompany) = _
Trim(LCase(CellValue(RowWebCrnt, ColWebCompany)))
Next
Do While True
If CellValue(RowRefCrnt, ColRefCompany) = "" Then
' Empty cell in reference company column. Assume end of list
Exit Do
End If
' This loop makes no assumptions about the sequence of the
' Reference and Web lists. If you know their sequences match or
' if you can sort the two pairs of columns, this loop could be
' made faster
' Set reference company name to lcase and remove leading and trailing
' spaces ready for matching
CellValue(RowRefCrnt, ColRefCompany) = _
Trim(LCase(CellValue(RowRefCrnt, ColRefCompany)))
For RowWebCrnt = RowDataFirst To RowLast
If CellValue(RowRefCrnt, ColRefCompany) = _
CellValue(RowWebCrnt, ColWebCompany) And _
CellValue(RowRefCrnt, ColRefDate) = _
CellValue(RowWebCrnt, ColWebDate) Then
' Reference and web values match.
' Record that the web values from row RowWebCrnt
' are to be copied to row RowRefCrnt
RowSave(RowWebCrnt) = RowRefCrnt
Exit For
End If
Next
RowRefCrnt = RowRefCrnt + 1
Loop
RowSaveCrnt = RowRefCrnt ' First row in save column that is available
' for unused web values
For RowWebCrnt = RowDataFirst To RowLast
If RowSave(RowWebCrnt) = 0 Then
' The web values on this row has not been matched to reference values.
' Record these web values are to be moved to the next available row
' in the save columns
RowSave(RowWebCrnt) = RowSaveCrnt
RowSaveCrnt = RowSaveCrnt + 1
End If
Next
.Columns(ColSaveCompany).ColumnWidth = .Columns(ColWebCompany).ColumnWidth
.Columns(ColSaveDate).ColumnWidth = .Columns(ColWebDate).ColumnWidth
' Copy values from web columns to save columns
For RowWebCrnt = RowDataFirst To RowLast
.Range(.Cells(RowWebCrnt, ColWebCompany), _
.Cells(RowWebCrnt, ColWebDate)).Copy _
Destination:=.Cells(RowSave(RowWebCrnt), ColSaveCompany)
Next
End With
End Sub