CODEWITHSUNDEEP
excelvba
Gurato
Gurato

Reputation: 23

Check Values and Populate cells in Excel

I have a list of points with the following "fields" (every field in a column, B to G):

Point Name (B), Easting (C), Northing (D), Survey Crew (E), Date of Survey (F), Survey Method (G)

The user have to input
Survey Crew (H2)
Survey Date (I2)
Survey Method (J2)
Line (H4) Point's Name first part
Start (I4)
End (J4)

And I want :
- Check if the point exists
- If the point exists and the "fields" are empty populate them with the info the user has to iput in some specific cells
- If the cells are already populated to retrieve the info to show it in some other cells
I've come to these code lines and they work but the check process take too long.

Could anyone help me to figure out how to do it faster? because every time the check is performed it takes too long.

I'm not so good on this and I think there could be one faster way to do it; any comment or suggestion is welcome

    Sub CheckProd()
    Dim FR1, Bin, Track, Min, MinBin, Max, MaxBin, Tre As Integer
    Bin = 10 ^ Range("O2").Value
    Track = Range("H4").Value 'Input value (first part of the point name)
    MinBin = Range("I4").Value ' Input Value (second part of the point name - Start)
    MaxBin = Range("J4").Value ' Input Value (second part of the point name - End)
    If MaxBin > MinBin Then ' calculates first and last point to update
        Min = Bin * Track + MinBin
        Max = Bin * Track + MaxBin
        Else
        Min = Bin * Track + MaxBin
        Max = Bin * Track + MinBin
    End If
    Tre = Max - Min + 1 'Counts number of points to update
    FR1 = Range("B65536").End(xlUp).Row 'Counts total design points points
    Range("K2:M65536").ClearContents
    Check = Min - 1
    For i = 1 To Tre
        Check = Check + 1
        Find = False
        For J = 2 To FR1
            Station = Cells(J, "B").Value
            datte = Cells(J, "F").Value
            If (Check = Station) Then
                Find = True
                If IsEmpty(Cells(J, "F")) Then
                    Cells(J, "E").Value = Cells(2, "H").Value 'Updates Crew number
                    Cells(J, "F").Value = Cells(2, "I").Value 'Updates Survey Date
                    Cells(J, "G").Value = Cells(2, "J").Value 'Updates Survey Method
                Else
                    FRL = Range("K65536").End(xlUp).Row
                    Cells(FRL + 1, "K").Value = Station 'Shows the point already reported
                    Cells(FRL + 1, "L").Value = "Reportado" 'Shows the status "Reported"
                    Cells(FRL + 1, "M").Value = datte ' Shows the date when the point was reported
                End If
            End If
            If ((J = FR1) And (Not Find)) Then
                FRM = Range("K65536").End(xlUp).Row
                Cells(FRM + 1, "K").Value = Check 'Shows the point without design coordinates
                Cells(FRM + 1, "L").Value = "No Preplot" 'Shows the status "No Preplot"
            End If
            If (Find) Then J = FR1
        Next J
    Next i
End Sub

Upvotes: 0

Views: 320

Answers (1)

Anonymous Type
Anonymous Type

Reputation: 3061

Everything up to the For loop will all things being equal will be ultra fast. Clearly the speed hit is in your double For loop. 

   For i = 1 To Tre
        Check = Check + 1
        Find = False
        For J = 2 To FR1
              'performance problem happens here...
        Next J
    Next i

The code isn't insanely bad.

But it's clear that you are moving through a large body of data doing a lookup. Doing this lots of times through a long loop isn't a great because your basically moving through a large number of iterations constantly examining individual cell values for little benefit (i.e. to lookup 3 values).

Instead consider replacing this "search algo" with a VLookup() or Index(Match()) function that uses the value in Cells(J, "B").Value to find the 3 values at Cells(2, "H").Value, Cells(2, "I").Value and Cells(2, "J").Value.

An even better method involving code is to read all values into an array at the start. To do this first load the data into the array. Ok your now no longer wasting time talking to Excel.

Dim arr()
arr = Range("H2:J666").Value2

Now re-write your "search algo" to process this Array. To do that you will reconstruct the For loop to iterate through the elements and dimensions of the variable arr. i.e.

For rowCount = 0 to 664
   For columnCount = 0 to 2
       If arr(rowCount, columnCount) = CheckValue(GetStationValue(station)) Then
             ' we have found the correct set of values
             Range("E" & J).Value = arr(rowCount,columnCount)
             Range("F" & J).Value = arr(rowCount,columnCount)
             Range("G" & J).Value = arr(rowCount,columnCount)
        Else
              ' do other update of data
        End If
    Next
Next

' where GetStation value is just a seperate function to get the dynamic "station" value based on the original station variable value (use global variable if you need to update this value), and CheckValue then compares this to the Check sum that you are using.

hope this helps.

Upvotes: 2

Related Questions