1
votes

I've trying to do the following and got stuck while doing so.

What I want to achieve:

  1. Search for a certain text/value in a range of headers of various worksheets (the certain text/value from a different worksheet "DB")
  2. When a header with that value is found, copy all the data below that header and paste it as a value in that same column
  3. AND, copy the formula that is 1 column to the right of column with matched header and 'paste formula' to the last row of a certain column of that corresponding worksheet(e.g., if header with the value is found on H11, copy the formula of I12 and paste upto last row of A in column I)
  4. Repeat this for all headers in the range of various worksheets

I searched various sources to come up with the below code.

Code I have so far:

Dim Lr1,lr2,lr3,lr4 As Long
Dim rng, c, rngAddress As Range
Dim period As String

period = Worksheets("DB").Range("Y1")
Lastrow1 = Worksheets("Calc_1").Cells(Rows.Count, "A").End(xlUp).Row
Lastrow2 = Worksheets("Calc_2").Cells(Rows.Count, "A").End(xlUp).Row
Lastrow3 = Worksheets("Calc_3").Cells(Rows.Count, "A").End(xlUp).Row
Lastrow4 = Worksheets("Calc_4").Cells(Rows.Count, "A").End(xlUp).Row

With Worksheets("Calc_1", "Calc_2", "Calc_3", "Calc_4")

    Set rng = Activesheet.Range("G11:Z11")

    For Each c In rng

        If c = period Then

            Range(c, c.End(xlDown)).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
 'cannot figure out the column to the right aspect here

        Else

        End If

    Next

End With

The vba doesn't run and I have a hard time figuring out the full code to achieve my goal. Would appreciate any help!

This is what I have after editing:

Dim period As String
Dim ws As Worksheet
Dim rng As Range

period = Worksheets("Model_DB").Range("Y1")
Lastrow1 = Worksheets("Calc_1").Range("A" & .Rows.Count).End(xlUp).Row
Lastrow2 = Worksheets("Calc_2").Range("A" & .Rows.Count).End(xlUp).Row
Lastrow3 = Worksheets("Calc_3").Range("A" & .Rows.Count).End(xlUp).Row

For Each ws In ThisWorkbook.Sheets
    Select Case ws.Name
    Case "Calc_1", "Calc_2", "Calc_3"
        With ws
            For Each rng In .Range("G11:Z11")
                If rng.Value = period Then
                   '/change to value/
                    Range(rng).Select.Copy
                    Range(rng & Lastrow1).Paste Special=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

                    '/put formula on the right column/
                    fn.Offset(1, 1).Copy
                    Range(rng & Lastrow1).Paste Special=xlPasteformulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                    Exit For
                End If
            Next rng
        End With
    End Select
Next ws
1
Though I do nto recommend using xlDown in such scenario but what you are trying to achieve can be done in one line rather than copying and paste special... .Columns(C.Column).Value = .Columns(C.Column).Value – Siddharth Rout
lol@Pᴇʜ: I was typing a long post. Already suggested that there... – Siddharth Rout

1 Answers

1
votes

There are lot of things I would recommend in your code.

Search for a certain text/value in a range of headers of various worksheets (the certain text/value from a different worksheet "DB") When a header with that value is found, copy all the data below that header and paste it as a value in that same column

A. Dim Lr1,lr2,lr3,lr4 As Long

In the above code, only the last variable lr4 will be declared as Long and the rest will be declared as Variants. Replace it with Dim Lr1 As Long,lr2 As Long,lr3 As Long,lr4 As Long. Variants slow up the code as during runtime, the code has to convert it to the relevant datatype. They should be avoided unless necessary.

B. With Worksheets("Calc_1", "Calc_2", "Calc_3", "Calc_4") Do not do this. What if the header is in a different column? Loop through the worksheets and use Select Case to work with relevant sheets

C. Selection.PasteSpecial Paste:=xlPasteValues..... You are trying to paste without copying? As I mentioned in the comments, I do not recommend using xlDown in such scenario. You are calculating the last row correctly at the begining of the code. Use that to define your range. However what you are trying to achieve can be done in one line rather than copying and paste special.

Your code can be shortened to (Untested)

Option Explicit

Sub Sample()
    Dim period As String
    Dim ws As Worksheet
    Dim rng As Range

    period = Worksheets("DB").Range("Y1")

    For Each ws In ThisWorkbook.Sheets
        Select Case ws.Name
        Case "Calc_1", "Calc_2", "Calc_3", "Calc_4"
            With ws
                For Each rng In .Range("G11:Z11")
                    If rng.Value = period Then
                        .Columns(rng.Column).Value = .Columns(rng.Column).Value
                        Exit For
                    End If
                Next rng
            End With
        End Select
    Next ws
End Sub

Let me know if you get any error in the above code.

D. Lastrow1 = Worksheets("Calc_1").Cells(Rows.Count, "A").End(xlUp).Row. To be on a safe side, fully qualify Rows.Count as well. I would recommned reading up on THIS.

As for point 3 and 4, Please show some efforts like you have done for point 1 and 2 and we will take it from there. :)