0

I'm very new to coding and VBA in general.

I'm trying to produce a macro that is looking up and mapping if elements (broken down by chainages or say distances with a start and end point) and then returning the risk ID for those elements. The code runs fine (I think) but when it loops through the elements it only returns the last iteration for that loop. I was thinking to potentially write a copy and paste function so that every time the condition is satisfied, it'll copy and paste it and move it onto a new row and this way it wouldn't over-ride for any risk IDs.

Option Explicit
Sub automated_gr_lookup()

Dim l As Variant
Dim gr As Variant
Dim st As Long
Dim en As Long
Dim c1 As Long
Dim c2 As Long
Dim c As Integer
Dim d As Integer

Sheets("Geotechnical Risk Register").Select

Application.ScreenUpdating = False

For c = 1 To 413
    Sheets("Geotechnical Risk Register").Select
    'gr = geotechnical risk'
    Cells(8 + c, 2).Select
    gr = Selection.Value
    'For M002'
    Cells(8 + c, 3).Select
    l = Selection.Value
        If l = "M002" Then

            'Start Chainage for GRR ID'
            Cells(8 + c, 4).Select
            st = Selection.Value
            'End Chainage for GRR ID'
            Cells(8 + c, 5).Select
            en = Selection.Value

            Sheets("DES P14 M002").Select
            For d = 1 To 74
            'Start Chainage for DES ID'
            Cells(2 + d, 3).Select
            c1 = Selection.Value
            'End Chainage for DES ID'
            Cells(2 + d, 4).Select
            c2 = Selection.Value

            'Conditions 1 to 4 - Geotechnical Risk falling within the Design Element Extent'
            If (en > c1 And en < c2) Or (st > c1 And en < c2) Or (st > c1 And st < c2) Or (st < c1 And en > c2) Then
                Sheets("DES P14 M002").Select
                Cells(2 + d, 8).Value = gr


            End If
            Next d


        End If


Next c

End Sub

Also, I know this isn't too much of a future proof way of doing things and I should maybe think of using Tables and defined names / references - I'm open to all solutions. I've only done the best I can.

halfer
  • 19,824
  • 17
  • 99
  • 186
MAfs
  • 3
  • 1
  • The line Cells(2+d,8).value = gr is what is causing the duplication problem. – MAfs Sep 26 '19 at 10:02
  • One problem I think is that your `d` loop is nested within your `c` loop so the value of `d` returns to 1 in every new iteration of the latter. You should also read https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba – SJR Sep 26 '19 at 10:05
  • SJR Thanks for that, seems like a very useful read. – MAfs Sep 26 '19 at 10:10

1 Answers1

0

(THAT IS NOT A REPLY BUT TO LONG FOR A COMMENT. PLEASE UNDERSTAND. I will delete it when we can get any clarification)

This is your code...

Option Explicit
Sub automated_gr_lookup()

Dim l As Variant
Dim gr As Variant
Dim st As Long
Dim en As Long
Dim c1 As Long
Dim c2 As Long
Dim c As Integer
Dim d As Integer



Application.ScreenUpdating = False

For c = 1 To 413
    Sheets("Geotechnical Risk Register").Activate
    gr = Cells(8 + c, 2).Value
    l = Cells(8 + c, 3).Value
        If l = "M002" Then
            st = Cells(8 + c, 4).Value
            en = Cells(8 + c, 5).Value
            Sheets("DES P14 M002").Activate
            For d = 1 To 74
                c1 = Cells(2 + d, 3).Value
                c2 = Cells(2 + d, 4).Value
                If (en > c1 And en < c2) Or (st > c1 And en < c2) Or _
                                            (st > c1 And st < c2) Or (st < c1 And en > c2) Then
                    Cells(2 + d, 8).Value = gr
                End If
            Next d
        End If
Next c
End Sub

Without all the select staff and comments, you can notice that you are just giving values to gr and l, when l="M002" then, you are giving values to st, en, c1 and c2 and just when the condition match then you are populating your column H at "DES P14 M002" sheet.

But (without any information of your data) you have the risk to place different gr data on the same cell on column H. Is that your idea?

David García Bodego
  • 1,058
  • 3
  • 13
  • 21