Allowing user to select range of columns for comparison

[Sambora]

I've got a macro that checks whether a value in one column matches the value in another column (same row) and enters the value in another column that either enters the same value as the first column or says that a check is required.

A couple of things that I'd like to change though. I'd like a user to be able to select which columns they want to compare without having to change the macro itself. I suppose I'd need some input boxes but I don't know to set this up. Ideally there'd a user would be asked to select the columns they want to compare (there'd only ever be 2) and the column that will indicate whether a check is required.

I'd also like to be able to select the number of rows at this stage or alternatively automate it somehow, so that it selects the first and last rows in the columns in the macro rather than require a user to do this. Currently the macro is set to check the first 10 rows but the number of rows will vary per report and I'd rather make this as easy as possible to set.

Can anyone offer any suggestions to re-write the below macro?

Sub Macro1()
Dim i As Long

For i = 1 To 10
If Range("A" & i).Value = Range("B" & i).Value Then
Range("F" & i).Value = Range("A" & i).Value
ElseIf Range("A" & i).Value <> Range("B" & i).Value Then
Range("F" & i).Value = "Check Req"
End If
Next

Worksheets("Sheet1").Activate
Worksheets("Sheet1").Range("F:F").Select
Selection.NumberFormat = "00000000"

End Sub

[Artik]

Sub CompareColumns()
Dim rngInput1 As Range
Dim rngInput2 As Range
Dim rngInput3 As Range
Dim vArr1 As Variant
Dim vArr2 As Variant
Dim vArr3 As Variant
Dim lLAstRow As Long
Dim i As Long
On Error Resume Next
Set rngInput1 = Application.InputBox("Select the first cell with data to compare in the first column:", , , , , , , 8)
If rngInput1 Is Nothing Then Exit Sub
Set rngInput2 = Application.InputBox("Select any cell in the second column:", , , , , , , 8)
If rngInput2 Is Nothing Then Exit Sub
Set rngInput3 = Application.InputBox("Select any cell in the third column:", , , , , , , 8)
If rngInput3 Is Nothing Then Exit Sub
On Error GoTo 0
lLAstRow = LastRow(ActiveSheet.Columns(rngInput1.Column))
If lLAstRow < rngInput1(1).Row Then Exit Sub
Set rngInput1 = Range(rngInput1(1), Cells(lLAstRow, rngInput1.Column))
Set rngInput2 = rngInput1.Offset(, rngInput2.Column - rngInput1.Column)
Set rngInput3 = rngInput1.Offset(, rngInput3.Column - rngInput1.Column)
vArr1 = rngInput1.value
vArr2 = rngInput2.value
ReDim vArr3(1 To UBound(vArr1), 1 To 1)
For i = 1 To UBound(vArr1)
If vArr1(i, 1) <> vArr2(i, 1) Then
vArr3(i, 1) = "Check Req"
Else
vArr3(i, 1) = vArr1(i, 1)
End If
Next i
rngInput3.NumberFormat = "00000000"
rngInput3.value = vArr3
rngInput3.EntireColumn.AutoFit
MsgBox "Done :)"
End Sub

Function LastRow(Rng As Range, Optional ByVal wht As String = "*") As Long
On Error Resume Next
LastRow = Rng.Find(What:=wht, _
After:=Rng.Cells(1), _
LookAt:=xlWhole, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Rng.Find What:="", LookAt:=xlPart
On Error GoTo 0
End Function

Atrik

[Sambora]

Glad I asked because I would never have been able to work that one out. I've done some initial testing it seems perfect.

Thanks very much!