I have had issue with wanting to pull in a cells color and not just the cells value. I have built this but if someone knows of an easier way to do it with a function or other <ACRONYM title="visual basic for applications">VBA</ACRONYM> please let me know. Thanks in advance.
Sub VBAlookup_Cell_Value_And_Color_Return()
' created November 2012 by Todd Hoerter
Dim lookupValue As String
Dim tableArray As String
Dim colIndexNum As String
Dim rangeLookup As String
Dim lastRow As Long
Dim rowCount As Integer
Dim currentValue As String
Dim rowNum As Long
Dim newInteriorColor As String
Dim lookupColorValue As String
Dim userInput1 As String
Dim userInput2 As String
Dim userInput3 As String
Dim userInput4 As String
Dim userInputrtWKB As Variant
Dim userInputluWKB As Variant
Dim getrtWKB As String
Dim getluWKB As String
Dim rtWBK As Workbook
Dim luWBK As Workbook
userInputrtWKB = InputBox("Workbook you are looking up From? ie. Data Return NOTE do not include the file extention")
userInputluWKB = InputBox("Workbook you are looking To? ie. Data Information NOTE do not include the file extention")
getrtWKB = (userInputrtWKB)
getluWKB = (userInputluWKB)
Set rtWBK = Workbooks(getrtWKB) ' this is the book that the valus get returned to
Set luWBK = Workbooks(getluWKB) ' this is the workbook that you lookup the values from
userInput1 = InputBox("Lookup Value? ie. A2")
userInput2 = InputBox("Table Array Pull value from what column ie.A:A?")
userInput4 = InputBox("Get Value from what column from the active lookup cell to the right, count the blank cells ie.4?")
Range("" & userInput1 & "").Select
ActiveCell(1, 2).EntireColumn.Insert
ActiveCell(0, 2).Value = "<ACRONYM title="visual basic for applications">VBA</ACRONYM> Vlookup Color Return"
Do
If ActiveCell <> "" Then
currentValue = ActiveCell.Offset(0, 0).Value
' look for the value in another worksheet or workbook
luWBK.Activate
Columns("" & userInput2 & "").Select
On Error Resume Next
Selection.Find(What:="" & currentValue & "").Select
lookupValue = ActiveCell.Offset(0, 0).Value
If currentValue = lookupValue Then
lookupValue = ActiveCell.Offset(0, "" & userInput4 & "").Value
lookupColorValue = ActiveCell.Offset(0, "" & userInput4 & "").Interior.color
newInteriorColor = lookupColorValue
If lookupColorValue = "" Then
lookupColorValue = "0"
ElseIf lookupColorValue = "16777215" Then
newInteriorColor = ""
Else:
End If
Else:
lookupValue = "#N/A"
newInteriorColor = lookupValue
End If
rtWBK.Activate
Else:
End If
' this returns the value that was found
ActiveCell.Offset(0, 1).Interior.color = (newInteriorColor)
ActiveCell.Offset(0, 1).Value = (lookupValue)
ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell = ""
End Sub
Sub VBAlookup_Cell_Value_And_Color_Return()
' created November 2012 by Todd Hoerter
Dim lookupValue As String
Dim tableArray As String
Dim colIndexNum As String
Dim rangeLookup As String
Dim lastRow As Long
Dim rowCount As Integer
Dim currentValue As String
Dim rowNum As Long
Dim newInteriorColor As String
Dim lookupColorValue As String
Dim userInput1 As String
Dim userInput2 As String
Dim userInput3 As String
Dim userInput4 As String
Dim userInputrtWKB As Variant
Dim userInputluWKB As Variant
Dim getrtWKB As String
Dim getluWKB As String
Dim rtWBK As Workbook
Dim luWBK As Workbook
userInputrtWKB = InputBox("Workbook you are looking up From? ie. Data Return NOTE do not include the file extention")
userInputluWKB = InputBox("Workbook you are looking To? ie. Data Information NOTE do not include the file extention")
getrtWKB = (userInputrtWKB)
getluWKB = (userInputluWKB)
Set rtWBK = Workbooks(getrtWKB) ' this is the book that the valus get returned to
Set luWBK = Workbooks(getluWKB) ' this is the workbook that you lookup the values from
userInput1 = InputBox("Lookup Value? ie. A2")
userInput2 = InputBox("Table Array Pull value from what column ie.A:A?")
userInput4 = InputBox("Get Value from what column from the active lookup cell to the right, count the blank cells ie.4?")
Range("" & userInput1 & "").Select
ActiveCell(1, 2).EntireColumn.Insert
ActiveCell(0, 2).Value = "<ACRONYM title="visual basic for applications">VBA</ACRONYM> Vlookup Color Return"
Do
If ActiveCell <> "" Then
currentValue = ActiveCell.Offset(0, 0).Value
' look for the value in another worksheet or workbook
luWBK.Activate
Columns("" & userInput2 & "").Select
On Error Resume Next
Selection.Find(What:="" & currentValue & "").Select
lookupValue = ActiveCell.Offset(0, 0).Value
If currentValue = lookupValue Then
lookupValue = ActiveCell.Offset(0, "" & userInput4 & "").Value
lookupColorValue = ActiveCell.Offset(0, "" & userInput4 & "").Interior.color
newInteriorColor = lookupColorValue
If lookupColorValue = "" Then
lookupColorValue = "0"
ElseIf lookupColorValue = "16777215" Then
newInteriorColor = ""
Else:
End If
Else:
lookupValue = "#N/A"
newInteriorColor = lookupValue
End If
rtWBK.Activate
Else:
End If
' this returns the value that was found
ActiveCell.Offset(0, 1).Interior.color = (newInteriorColor)
ActiveCell.Offset(0, 1).Value = (lookupValue)
ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell = ""
End Sub