Cell Referencing - Recognizing Data from Row

[carrieebacon]

Okay A) I would like to apologize for constantly posting on here, but I am learning. B) I have one sheet in a workbook that contains asbuilt data (ASBUILT), and one sheet that will be used to format the text that I will place into Trimble Business Center (TBC TEXT). I would like to pull (or reference) from column J in ASBUILT to place into either column D, F, I, or L. The thing is, it needs to align with the correct ID number in column B in ASBUILT. If there is a better way to do what I am trying to do, feel free to tell me. I have been working on putting this together for a while and I think I have lost my sanity.

Here is what I am working with.

This is the ASBUILT sheet

And this is the TBC TEXT sheet

 

[carrieebacon]

Final Template 02.22.2024.xlsx | Powered by Box

 

[mumps]

Click here for your file. Your original file was quite large at over 17 megabytes. The reason for this is the fact that the used range in the AS-BUILT sheet included the maximum number of rows permitted by Excel in any one sheet (1048756). I have corrected this and you will notice that the attached file is quite small at 231 kilobytes. I suggest that you use the attached version of the file going forward. This is the revised code:

Sub FillElevation()
    Application.ScreenUpdating = False
    Dim v1 As Variant, v2 As Variant, i As Long, ii As Long, srcWS As Worksheet, desWS As Worksheet
    Dim Val1 As String, Val2 As String, Val3 As String, Val4 As String, fnd As Range
    Set srcWS = Sheets("AS-BUILT")
    Set desWS = Sheets("TBC TEXT")
    v1 = desWS.Range("A5", desWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 12).Value
    v2 = srcWS.Range("I5", srcWS.Range("I" & Rows.Count).End(xlUp)).Resize(, 6).Value
    For i = LBound(v1) To UBound(v1)
        If WorksheetFunction.CountIf(srcWS.Range("I4", srcWS.Range("I" & Rows.Count).End(xlUp)), v1(i, 1)) > 0 Then
            Val1 = v1(i, 1) & "|" & v1(i, 6)
            Val2 = v1(i, 1) & "|" & v1(i, 9)
            Val3 = v1(i, 1) & "|" & v1(i, 12)
            For ii = LBound(v2) To UBound(v2)
                If v2(ii, 1) & "|" & v2(ii, 3) = Val1 Then
                    desWS.Range("E" & i + 4) = v2(ii, 6)
                ElseIf v2(ii, 1) & "|" & v2(ii, 3) = Val2 Then
                    desWS.Range("H" & i + 4) = v2(ii, 6)
                ElseIf v2(ii, 1) & "|" & v2(ii, 3) = Val3 Then
                    desWS.Range("K" & i + 4) = v2(ii, 6)
                End If
            Next ii
        End If
    Next i
    For ii = LBound(v2) To UBound(v2)
        If v2(ii, 2) <> "" And v2(ii, 3) = "" Then
            Set fnd = desWS.Range("A:A").Find(v2(ii, 1), LookIn:=xlValues, lookat:=xlWhole)
            If Not fnd Is Nothing Then
                desWS.Range("C" & fnd.Row) = v2(ii, 6)
            End If
        End If
    Next ii
    Application.ScreenUpdating = True
End Sub

 

[carrieebacon]

This is the very last time I am coming back to this thread I promise! I have made all of the tweaks I could possibly make and its about time to put this workbook to use. I hate that I cannot figure out this code to do it myself and have to bother others. Is there anyway you can help me with the fill elevation code again?
FXL Workbook 04.08.2024

 

[mumps]

Try:

Sub FillElevation()
    Application.ScreenUpdating = False
    Dim v1 As Variant, v2 As Variant, i As Long, ii As Long, srcWS As Worksheet, desWS As Worksheet
    Dim Val1 As String, Val2 As String, Val3 As String, Val4 As String, fnd As Range
    Set srcWS = Sheets("AS-BUILT")
    Set desWS = Sheets("TBC TEXT")
    v1 = desWS.Range("A7", desWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 20).Value
    v2 = srcWS.Range("J7", srcWS.Range("J" & Rows.Count).End(xlUp)).Resize(, 7).Value
    For i = LBound(v1) To UBound(v1)
        If v1(i, 1) <> "" And WorksheetFunction.CountIf(srcWS.Range("J7", srcWS.Range("J" & Rows.Count).End(xlUp)), Trim(v1(i, 1))) > 0 Then
            Val1 = Trim(v1(i, 1)) & "|" & v1(i, 6)
            Val2 = Trim(v1(i, 1)) & "|" & v1(i, 9)
            Val3 = Trim(v1(i, 1)) & "|" & v1(i, 12)
            For ii = LBound(v2) To UBound(v2)
                If v2(ii, 1) & "|" & v2(ii, 3) = Val1 Then
                    desWS.Range("E" & i + 6) = v2(ii, 7)
                ElseIf v2(ii, 1) & "|" & v2(ii, 3) = Val2 Then
                    desWS.Range("H" & i + 6) = v2(ii, 7)
                ElseIf v2(ii, 1) & "|" & v2(ii, 3) = Val3 Then
                    desWS.Range("K" & i + 6) = v2(ii, 7)
                End If
            Next ii
        End If
    Next i
    For ii = LBound(v2) To UBound(v2)
        If v2(ii, 1) <> "" And v2(ii, 2) <> "" And v2(ii, 3) = "" Then
            Set fnd = desWS.Range("A:A").Find("*" & v2(ii, 1) & "*", LookIn:=xlValues, lookat:=xlWhole)
            If Not fnd Is Nothing Then
                desWS.Range("C" & fnd.Row) = v2(ii, 7)
            End If
        End If
    Next ii
    Application.ScreenUpdating = True
End Sub

 

[carrieebacon]

That worked! But some of the numbers increase decimal places and while I can fix that in the cells they appear in, the cells that have formulas referencing those numbers do not update. any ideas? For example, 10.06 becomes 10.06190476.

 

[mumps]

Try:

Sub FillElevation()
    Application.ScreenUpdating = False
    Dim v1 As Variant, v2 As Variant, i As Long, ii As Long, srcWS As Worksheet, desWS As Worksheet
    Dim Val1 As String, Val2 As String, Val3 As String, Val4 As String, fnd As Range
    Set srcWS = Sheets("AS-BUILT")
    Set desWS = Sheets("TBC TEXT")
    v1 = desWS.Range("A7", desWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 20).Value
    v2 = srcWS.Range("J7", srcWS.Range("J" & Rows.Count).End(xlUp)).Resize(, 7).Value
    For i = LBound(v1) To UBound(v1)
        If v1(i, 1) <> "" And WorksheetFunction.CountIf(srcWS.Range("J7", srcWS.Range("J" & Rows.Count).End(xlUp)), Trim(v1(i, 1))) > 0 Then
            Val1 = Trim(v1(i, 1)) & "|" & v1(i, 6)
            Val2 = Trim(v1(i, 1)) & "|" & v1(i, 9)
            Val3 = Trim(v1(i, 1)) & "|" & v1(i, 12)
            For ii = LBound(v2) To UBound(v2)
                If v2(ii, 1) & "|" & v2(ii, 3) = Val1 Then
                    desWS.Range("E" & i + 6) = Format(v2(ii, 7), "0.00")
                ElseIf v2(ii, 1) & "|" & v2(ii, 3) = Val2 Then
                    desWS.Range("H" & i + 6) = Format(v2(ii, 7), "0.00")
                ElseIf v2(ii, 1) & "|" & v2(ii, 3) = Val3 Then
                    desWS.Range("K" & i + 6) = Format(v2(ii, 7), "0.00")
                End If
            Next ii
        End If
    Next i
    For ii = LBound(v2) To UBound(v2)
        If v2(ii, 1) <> "" And v2(ii, 2) <> "" And v2(ii, 3) = "" Then
            Set fnd = desWS.Range("A:A").Find("*" & v2(ii, 1) & "*", LookIn:=xlValues, lookat:=xlWhole)
            If Not fnd Is Nothing Then
                desWS.Range("C" & fnd.Row) = Format(v2(ii, 7), "0.00")
            End If
        End If
    Next ii
    Application.ScreenUpdating = True
End Sub