Forum Discussion
JoAvg
Jan 19, 2023Brass Contributor
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 ...
- Jan 20, 2023
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
JoAvg
Jan 20, 2023Brass Contributor
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
Jan 20, 2023MVP
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- JoAvgJan 20, 2023Brass Contributor
Like a boss...
Thanks a ton!!!