Macro Modification needed

Hi all, I am in need of a major code modification.

Raw data imported in sheets Data_L101, Data_L103, Data_L111, Data_L201,Data_L203,Data_L211, Data_L701, Data_L703.

Sheet "AS-BUILT" is where all info is presented, and where the macro is gonna be run from.
Sheets LISTS & FORMULAS are where all data is calculated.

So, what I would like to do is, e.g:
For FORMULAS!C11=Data_L101 or Data_L103, Data_L111, Data_L201,Data_L203,
Look for value FORMULAS!B12 in sheet DATA_L101 col E and when value found:
1. Fill FORMULAS!B7 in col K.
2. Fill FORMULAS!J10 in col L.
3. Fill FORMULAS!C2 in col N.
4. Fill TODAY() in col O.
5. Fill FORMULAS!C3 in col P.
6. Fill FORMULAS!C4 in col Q.
7. Fill FORMULAS!C5 in col R.
8. Fill "DONE" in col S
9. Make Shape "TICK1" visible

However, when FORMULAS!C11=DATA_L701, DATA_703 the code should:
Look for value FORMULAS!B15 in sheet DATA_L701 col K and when value found:
1. Fill FORMULAS!B7 in col K.
2. Fill FORMULAS!C8 in col J.
3. Fill FORMULAS!C2 in col N.
4. Fill TODAY() in col O.
5. Fill FORMULAS!C3 in col P.
6. Fill FORMULAS!C4 in col Q.
7. Fill FORMULAS!C5 in col R.
8. Fill "DONE" in col S
9. Make Shape "TICK1" visible

Previous workbook code by HansVogelaar was:

Sub Drawn()
    Dim v As String
    Dim w As Worksheet
    Dim rng As Range
    Dim r As Long
    v = Range("C10").Text
    If v = "" Then Exit Sub
    For Each w In Worksheets(Array("SL_2019", "SL_2021", "SL_2022"))
        Set rng = w.Range("G:G").Find(What:=v, LookIn:=xlValues, LookAt:=xlWhole)
        If Not rng Is Nothing Then
            r = rng.Row
            w.Range("L" & r).Value = Date
            w.Range("M" & r).Value = "USER"
            w.Range("Q" & r).Value = "DRAWN"
            w.Range("J" & r).Value = Range("C16").Value
            w.Range("K" & r).Value = Range("C17").Value
        End If
    Next w
End Sub

Hoping of some help here.

Easy-peasy:

Sub Drawn2()
    Dim wF As Worksheet
    Dim v As String
    Dim w As Worksheet
    Dim s As String
    Dim rng As Range
    Dim r As Long
    Set wF = Worksheets("Formulas")
    v = wF.Range("C11").Text
    On Error Resume Next
    Set w = Worksheets(v)
    On Error GoTo 0
    If w Is Nothing Then Exit Sub
    Select Case v
        Case "DATA_L101", "DATA_L103", "DATA_L111", "DATA_L201", "DATA_L203", "DATA_L211"
            s = wF.Range("B12").Text
            Set rng = w.Range("E:E").Find(What:=s, LookIn:=xlValues, LookAt:=xlWhole)
        Case "DATA_L701", "DATA_L703"
            s = wF.Range("B15").Text
            Set rng = w.Range("K:K").Find(What:=s, LookIn:=xlValues, LookAt:=xlWhole)
    End Select
    If Not rng Is Nothing Then
        r = rng.Row
        Select Case v
            Case "DATA_L101", "DATA_L103", "DATA_L111", "DATA_L201", "DATA_L203", "DATA_L211"
                w.Range("K" & r).Value = wF.Range("B7").Value
                w.Range("L" & r).Value = wF.Range("J10").Value
            Case "DATA_L701", "DATA_L703"
                w.Range("J" & r).Value = wF.Range("C8").Value
        End Select
        w.Range("N" & r).Value = wF.Range("C2").Value
        w.Range("O" & r).Value = Date ' or "=TODAY()"
        w.Range("P" & r).Value = wF.Range("C3").Value
        w.Range("Q" & r).Value = wF.Range("C4").Value
        w.Range("R" & r).Value = wF.Range("C5").Value
        w.Range("S" & r).Value = "DONE"
        Worksheets("AS_BUILT").Shapes("TICK1").Visible = msoCTrue
    End If
End Sub

HansVogelaar

MVP

Jan 19, 2023

JoAvg

Try this:

Sub Drawn2()
    Dim wF As Worksheet
    Dim v As String
    Dim w As Worksheet
    Dim s As String
    Dim rng As Range
    Dim r As Long
    Set wF = Worksheets("Formulas")
    v = wF.Range("C11").Text
    On Error Resume Next
    Set w = Worksheets(v)
    On Error GoTo 0
    If w Is Nothing Then Exit Sub
    Select Case v
        Case "DATA_L101", "DATA_L103", "DATA_L111", "DATA_L201", "DATA_L203", "DATA_L211"
            s = wF.Range("B12").Text
            Set rng = w.Range("E:E").Find(What:=s, LookIn:=xlValues, LookAt:=xlWhole)
        Case "DATA_L701", "DATA_L703"
            s = wF.Range("B15").Text
            Set rng = w.Range("K:K").Find(What:=s, LookIn:=xlValues, LookAt:=xlWhole)
    End Select
    If Not rng Is Nothing Then
        r = rng.Row
        w.Range("K" & r).Value = wF.Range("B7").Value
        Select Case v
            Case "DATA_L101", "DATA_L103", "DATA_L111", "DATA_L201", "DATA_L203", "DATA_L211"
                w.Range("L" & r).Value = wF.Range("J10").Value
            Case "DATA_L701", "DATA_L703"
                w.Range("J" & r).Value = wF.Range("C8").Value
        End Select
        w.Range("N" & r).Value = wF.Range("C2").Value
        w.Range("O" & r).Value = Date ' or "=TODAY()"
        w.Range("P" & r).Value = wF.Range("C3").Value
        w.Range("Q" & r).Value = wF.Range("C4").Value
        w.Range("R" & r).Value = wF.Range("C5").Value
        w.Range("S" & r).Value = "DONE"
        Worksheets("AS_BUILT").Shapes("TICK1").Visible = msoCTrue
    End If
End Sub

Please test thoroughly on a copy of the workbook!

JoAvg

Brass Contributor

Jan 20, 2023

HansVogelaar

Hi Hans, thank you for the immediate reply.
The code works everywhere, but I made a mistake in description.
When searching for DATA_L701, DATA_703, the code must omit step number 1 "1. Fill FORMULAS!B7 in col K" since it is the column used for search.
If you could rework the code to work this way it would be great.

HansVogelaar

MVP

Jan 20, 2023

JoAvg

Easy-peasy:

Sub Drawn2()
    Dim wF As Worksheet
    Dim v As String
    Dim w As Worksheet
    Dim s As String
    Dim rng As Range
    Dim r As Long
    Set wF = Worksheets("Formulas")
    v = wF.Range("C11").Text
    On Error Resume Next
    Set w = Worksheets(v)
    On Error GoTo 0
    If w Is Nothing Then Exit Sub
    Select Case v
        Case "DATA_L101", "DATA_L103", "DATA_L111", "DATA_L201", "DATA_L203", "DATA_L211"
            s = wF.Range("B12").Text
            Set rng = w.Range("E:E").Find(What:=s, LookIn:=xlValues, LookAt:=xlWhole)
        Case "DATA_L701", "DATA_L703"
            s = wF.Range("B15").Text
            Set rng = w.Range("K:K").Find(What:=s, LookIn:=xlValues, LookAt:=xlWhole)
    End Select
    If Not rng Is Nothing Then
        r = rng.Row
        Select Case v
            Case "DATA_L101", "DATA_L103", "DATA_L111", "DATA_L201", "DATA_L203", "DATA_L211"
                w.Range("K" & r).Value = wF.Range("B7").Value
                w.Range("L" & r).Value = wF.Range("J10").Value
            Case "DATA_L701", "DATA_L703"
                w.Range("J" & r).Value = wF.Range("C8").Value
        End Select
        w.Range("N" & r).Value = wF.Range("C2").Value
        w.Range("O" & r).Value = Date ' or "=TODAY()"
        w.Range("P" & r).Value = wF.Range("C3").Value
        w.Range("Q" & r).Value = wF.Range("C4").Value
        w.Range("R" & r).Value = wF.Range("C5").Value
        w.Range("S" & r).Value = "DONE"
        Worksheets("AS_BUILT").Shapes("TICK1").Visible = msoCTrue
    End If
End Sub

Forum Discussion

Macro Modification needed

Share

Resources