VBA finding closest number different spreadsheet

[epactheactor]

Hello everyone.

I'm still a newbie through I am currently in school to try and figure out VBA.

I have a unique issue which I'm sure has an answer that I'm not seeing. I know it can be solved using vLookup or a loop to go through the range then using offset, but I'm having trouble starting it.

I'm trying to create a macro that will go though all numbers in a single column in one spreadsheet ("New" spreadsheet, Column A) then search all the numbers in a separate spreadsheet ("Base" Spreadsheet, Column C) for the closest number. If one is found, it would put a number in a different column in the "Base" Spreadsheet.

Reason for the macro and not just a formula is that the columns will sometimes be different, so I would have to put a prompt saying which column to look at each time the macro is used.

Any help to point me in the right direction would be greatly appreciated.
Thank you.

 

[MickG]

Try this for results in column "D" of "Base" Sheet.

[COLOR="Navy"]Sub[/COLOR] MG17Dec33
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] omin [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rng1 [COLOR="Navy"]As[/COLOR] Range, k [COLOR="Navy"]As[/COLOR] Variant, Num [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]

[COLOR="Navy"]With[/COLOR] Sheets("New")
    [COLOR="Navy"]Set[/COLOR] Rng = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With

[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng: .Item(Dn.Value) = Empty: [COLOR="Navy"]Next[/COLOR]

[COLOR="Navy"]With[/COLOR] Sheets("Base")
    [COLOR="Navy"]Set[/COLOR] Rng1 = .Range("C1", .Range("C" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With

[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng1
    omin = Application.Max(Rng)
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] .keys
        [COLOR="Navy"]If[/COLOR] Abs((Dn.Value) - (k)) < omin [COLOR="Navy"]Then[/COLOR]
            omin = Abs((Dn.Value) - (k))
            Num = k
        [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] k
Dn.Offset(, 1).Value = Num
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[epactheactor]

Hi Mick,

Thank you so much! I apologize for this, but I'm really trying to learn how VBA works so please correct me if I'm wrong about this;

You created two ranges, with one on each spreadsheet then stored "New's" range in a dictionary object. Then you created a loop to go through and compare the 2nd range (base's) number to see if it was the highest number in regards to the first range, and if it wasn't, it returned the closest.

Would it be possible to instead of putting the closest number of the first range in the offset, to put a character or number of the number that is closest instead? It would mean that in the base's spreadsheet for the offset, only a few cells would have a value as only a few would be the closest value. Does that make sense? I would think it could be something as simple as just stating the Offset.Value = "X" or whatever, but I know that would mark every cell with an X and not the ones with the closest value.

Thank you again for your help.

 

[MickG]

Perhaps this:-
This code will place an "X" in column "E" of sheet Base, where that value has the closest difference (say difference of "1", could be any number) in column "A" of sheet "New.
So if there are 4 different values in column "C" sheet "base" that are within that "1" difference (closest difference) of a value in sheet "New" column "A", then those values in column "E" will be Marked.

[COLOR="Navy"]Sub[/COLOR] MG18Dec29
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] omin [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rng1 [COLOR="Navy"]As[/COLOR] Range, k [COLOR="Navy"]As[/COLOR] Variant, Num [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]

[COLOR="Navy"]With[/COLOR] Sheets("New")
    [COLOR="Navy"]Set[/COLOR] Rng = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With

[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng: .Item(Dn.Value) = Empty: [COLOR="Navy"]Next[/COLOR]

[COLOR="Navy"]With[/COLOR] Sheets("Base")
    [COLOR="Navy"]Set[/COLOR] Rng1 = .Range("C1", .Range("C" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With

[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng1
    omin = Application.Max(Rng)
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] .keys
        [COLOR="Navy"]If[/COLOR] Abs((Dn.Value) - (k)) < omin [COLOR="Navy"]Then[/COLOR]
            omin = Abs((Dn.Value) - (k))
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] k
    Dn.Offset(, 1).Value = omin
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] With

omin = Application.Min(Rng1.Offset(, 1))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng1.Offset(, 1)
    [COLOR="Navy"]If[/COLOR] Dn.Value = omin [COLOR="Navy"]Then[/COLOR]
        Dn.Value = "X"
    [COLOR="Navy"]Else[/COLOR]
        Dn.ClearContents
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick