First of all , congratulations for this top programming forum , and sorry if my english is not so clear , anyway I go straight to the point: I have the following routine (part of the code was picked up from this forum)that I use to compare two different column and for reporting (if values matches) the value in the first range under a specific column .
The problem is:
1) Is it possible to speed-up the code (basically I compare column with 4000-8000 records) It takes too long.
2) it could happen that one of the two columns need to be trimmed but in this case trim seems not working.Why?
3) Is It possible to set a sort of progressive bar or something like that (point 3 is not really important)to see the status.
I have not so much experience in VBA (sorry) , here is the code:
[VBA]
Sub Mousepare()
Const strTitleSelectRange_c As String = "Select Range"
Dim rng1 As Excel.Range
Dim rng2 As Excel.Range
Dim cella As Object
Dim cella2 As Object
Dim C As String
Dim R As Integer
Dim c1r As Integer
Dim c2r As Integer
Dim c1c As Integer
Dim c2c As Integer
Dim tot As Integer
' Definisci i range
Set rng1 = GetRange("Select range n?1 with mouse:", strTitleSelectRange_c)
Set rng2 = GetRange("Select range n?2 with mouse :", strTitleSelectRange_c)
R = InputBox("Select offset (number value) to report:")
C = InputBox("Select column where report the value:")
contatore = 1
For Each cella In rng1
For Each cella2 In rng2
Trim (cella.Value)
Trim (cella2.Value)
c1r = cella.Row
c2r = cella2.Row
'c1c = cella.Column
'c2c = cella.Column
If cella2 = cella Then
'Range(C & c1r).Value = cella2.Offset(0, 1).Value
Range(C & c1r).Value = cella2.Offset(0, R).Value
End If
contatore = contatore + 1
Next cella2
Next cella
End Sub
Private Function GetRange(Prompt As String, Title As String) As Excel.Range
On Error Resume Next
Const lngRange_c As Long = 8
Set GetRange = Excel.Application.InputBox(Prompt, Title, Type:=lngRange_c)
End Function
[/VBA]
Best Regards
Tuxy(Italy)