SOLVED

Macro Modification needed

Brass Contributor

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 @Hans Vogelaar  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.

 

4 Replies

@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!

@Hans Vogelaar 

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.

best response confirmed by JoAvg (Brass Contributor)
Solution

@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

@Hans Vogelaar 

Like a boss...
Thanks a ton!!!

1 best response

Accepted Solutions
best response confirmed by JoAvg (Brass Contributor)
Solution

@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

View solution in original post