Excel VBA Find and Fill Help

[GeorgeWhite]

Hi,

I recently created a spreadsheet full of part numbers for items which had a location, I was able to create a macro that would go through a long list of these parts and find the locations on the location sheet.

Please see below the macro I used:

Sub Location()

Application.ScreenUpdating = False


Dim IDump As Worksheet
Dim c As Range
Dim d As String
Dim a As Range
Dim b As Integer


    b = 2
    Do Until b = 1921
    Set a = Worksheets("All Parts").Cells(b, 1)
    Set IDump = Sheets("Stores Location")
    Set c = IDump.Range("B3:BE226").Find(What:=a, LookIn:=xlValues, LookAt:=xlWhole)
    On Error GoTo Error
    If c.Row < 15 Then
    a.Offset(0, 9) = 1
    ElseIf c.Row < 28 Then
    a.Offset(0, 9) = 2
    ElseIf c.Row < 41 Then
    a.Offset(0, 9) = 3
    ElseIf c.Row < 54 Then
    a.Offset(0, 9) = 4
    ElseIf c.Row < 67 Then
    a.Offset(0, 9) = 5
    ElseIf c.Row < 80 Then
    a.Offset(0, 9) = 6
    ElseIf c.Row < 94 Then
    a.Offset(0, 9) = 7
    ElseIf c.Row < 107 Then
    a.Offset(0, 9) = 8
    ElseIf c.Row < 120 Then
    a.Offset(0, 9) = 9
    ElseIf c.Row < 133 Then
    a.Offset(0, 9) = 10
    ElseIf c.Row < 146 Then
    a.Offset(0, 9) = 11
    ElseIf c.Row < 156 Then
    a.Offset(0, 9) = 12
    ElseIf c.Row < 167 Then
    a.Offset(0, 9) = 13
    ElseIf c.Row < 178 Then
    a.Offset(0, 9) = 14
    ElseIf c.Row < 189 Then
    a.Offset(0, 9) = 15
    ElseIf c.Row < 196 Then
    a.Offset(0, 9) = 16
    ElseIf c.Row < 208 Then
    a.Offset(0, 9) = 17
    Else
    a.Offset(0, 9) = 18
    End If
    
    If c.Column < 16 Then
    a.Offset(0, 10) = 1
    ElseIf c.Column < 30 Then
    a.Offset(0, 10) = 2
    ElseIf c.Column < 37 Then
    a.Offset(0, 10) = 3
    ElseIf c.Column < 44 Then
    a.Offset(0, 10) = 4
    ElseIf c.Column < 51 Then
    a.Offset(0, 10) = 5
    Else
    a.Offset(0, 10) = 6
    End If
    
    If c.Row = 81 Then
    a.Offset(0, 11) = 13
    ElseIf c.Row = 3 Or c.Row = 16 Or c.Row = 29 Or c.Row = 42 Or c.Row = 55 Or c.Row = 68 Or c.Row = 82 Or c.Row = 95 Or c.Row = 108 Or c.Row = 121 Or c.Row = 134 Then
    a.Offset(0, 11) = 12
    ElseIf c.Row = 4 Or c.Row = 17 Or c.Row = 30 Or c.Row = 43 Or c.Row = 56 Or c.Row = 69 Or c.Row = 83 Or c.Row = 96 Or c.Row = 109 Or c.Row = 122 Or c.Row = 135 Or c.Row = 197 Then
    a.Offset(0, 11) = 11
    ElseIf c.Row = 5 Or c.Row = 18 Or c.Row = 31 Or c.Row = 44 Or c.Row = 57 Or c.Row = 70 Or c.Row = 84 Or c.Row = 97 Or c.Row = 110 Or c.Row = 123 Or c.Row = 136 Or c.Row = 157 Or c.Row = 168 Or c.Row = 179 Or c.Row = 198 Or c.Row = 209 Then
    a.Offset(0, 11) = 10
    ElseIf c.Row = 6 Or c.Row = 19 Or c.Row = 32 Or c.Row = 45 Or c.Row = 58 Or c.Row = 71 Or c.Row = 85 Or c.Row = 98 Or c.Row = 111 Or c.Row = 124 Or c.Row = 137 Or c.Row = 147 Or c.Row = 158 Or c.Row = 169 Or c.Row = 180 Or c.Row = 199 Or c.Row = 210 Then
    a.Offset(0, 11) = 9
    ElseIf c.Row = 7 Or c.Row = 20 Or c.Row = 33 Or c.Row = 46 Or c.Row = 59 Or c.Row = 72 Or c.Row = 86 Or c.Row = 99 Or c.Row = 112 Or c.Row = 125 Or c.Row = 138 Or c.Row = 148 Or c.Row = 159 Or c.Row = 170 Or c.Row = 181 Or c.Row = 200 Or c.Row = 211 Then
    a.Offset(0, 11) = 8
    ElseIf c.Row = 8 Or c.Row = 21 Or c.Row = 34 Or c.Row = 47 Or c.Row = 60 Or c.Row = 73 Or c.Row = 87 Or c.Row = 100 Or c.Row = 113 Or c.Row = 126 Or c.Row = 139 Or c.Row = 149 Or c.Row = 160 Or c.Row = 171 Or c.Row = 182 Or c.Row = 201 Or c.Row = 212 Then
    a.Offset(0, 11) = 7
    ElseIf c.Row = 9 Or c.Row = 22 Or c.Row = 35 Or c.Row = 48 Or c.Row = 61 Or c.Row = 74 Or c.Row = 88 Or c.Row = 101 Or c.Row = 112 Or c.Row = 127 Or c.Row = 140 Or c.Row = 150 Or c.Row = 161 Or c.Row = 172 Or c.Row = 183 Or c.Row = 190 Or c.Row = 202 Or c.Row = 213 Then
    a.Offset(0, 11) = 6
    ElseIf c.Row = 10 Or c.Row = 23 Or c.Row = 36 Or c.Row = 49 Or c.Row = 62 Or c.Row = 75 Or c.Row = 89 Or c.Row = 102 Or c.Row = 113 Or c.Row = 128 Or c.Row = 141 Or c.Row = 151 Or c.Row = 162 Or c.Row = 173 Or c.Row = 184 Or c.Row = 191 Or c.Row = 203 Or c.Row = 214 Then
    a.Offset(0, 11) = 5
    ElseIf c.Row = 11 Or c.Row = 24 Or c.Row = 37 Or c.Row = 50 Or c.Row = 63 Or c.Row = 76 Or c.Row = 90 Or c.Row = 103 Or c.Row = 114 Or c.Row = 129 Or c.Row = 142 Or c.Row = 152 Or c.Row = 163 Or c.Row = 174 Or c.Row = 185 Or c.Row = 192 Or c.Row = 204 Or c.Row = 215 Then
    a.Offset(0, 11) = 4
    ElseIf c.Row = 12 Or c.Row = 25 Or c.Row = 38 Or c.Row = 51 Or c.Row = 64 Or c.Row = 77 Or c.Row = 91 Or c.Row = 104 Or c.Row = 115 Or c.Row = 130 Or c.Row = 143 Or c.Row = 153 Or c.Row = 164 Or c.Row = 175 Or c.Row = 186 Or c.Row = 193 Or c.Row = 205 Or c.Row = 216 Then
    a.Offset(0, 11) = 3
    ElseIf c.Row = 13 Or c.Row = 26 Or c.Row = 39 Or c.Row = 52 Or c.Row = 65 Or c.Row = 78 Or c.Row = 92 Or c.Row = 105 Or c.Row = 116 Or c.Row = 131 Or c.Row = 144 Or c.Row = 154 Or c.Row = 165 Or c.Row = 176 Or c.Row = 187 Or c.Row = 194 Or c.Row = 206 Or c.Row = 217 Then
    a.Offset(0, 11) = 2
    Else
    a.Offset(0, 11) = 1
    End If
          
Error:
    Resume Parts
    
Parts:
    b = b + 1
    Loop
    
    Exit Sub
    
    Application.ScreenUpdating = True
    
End Sub

I am now looking for some help to create a new macro which will work the same way, it will go through the long list of items searching for them on the location spreadsheet but I would like for it to fill the cell with a colour when it finds the part. This is so we can identify what parts we actually have in a location and what parts are missing from my spreadsheet.

Many thanks.

 

[GeorgeWhite]

I have searched around but cannot find anything similar to what I am after.

 

[Teeroy]

Hi and welcome to the forum.

Here's an example of highlighting a certain value in the activesheet.

Sub Highlight_Values()
Dim Rng As Range, sTarget As String

sTarget = "Your Value"

With ActiveSheet.UsedRange
    Set Rng = .Find(what:=sTarget, After:=.Cells(.Rows.Count, .Columns.Count), LookIn:=xlValues, lookat:=xlWhole)
    Set FirstRng = Rng
    If Not Rng Is Nothing Then
        Do
            Rng.Interior.Color = vbRed
            Set Rng = .FindNext(After:=Rng)
        Loop While FirstRng.Address <> Rng.Address
    End If
End With
End Sub

Here's also a way you could tidy up the first part of the code that you posted; about 30 lines could be replaced by 2.
It may not be completely correct as you change your sequence part way through from every 13 lines (up to row 146) to various values.

iMyOffset = WorksheetFunction.Min(Int(c.Row / 13) + 1, 18)
a.Offset(0, 9) = iMyOffset

There's usually an easy algorithmic way to calculate an offset if you are dealing with a sequence.

Hope this helps.

 

[GeorgeWhite]

Hello Teeroy,

This worked perfectly!!

Thank you for your help, also thanks for helping shorten my original macro.

 

[Teeroy]

You're welcome.