1

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
0m3r
  • 12,286
  • 15
  • 35
  • 71
james
  • 11
  • 3
  • 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 Jan 08 '19 at 07:01
  • lol@Pᴇʜ: I was typing a long post. Already suggested that there... – Siddharth Rout Jan 08 '19 at 07:06

1 Answers1

1

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. :)

Siddharth Rout
  • 147,039
  • 17
  • 206
  • 250
  • hi! thank you so much for the detailed explanation. I am very new to vba so just trying to it as simply as possible. The code you put works, but only on 1 column. (i.e., I have 2 columns that have a match but only the first column changes to value. Also, the reason why I wanted to define the specific range is because 1. There are cells above these column that need to stay as formula, but this code changes everything to value 2. I want this model to be the basis for my future VBA plans for this workbook and need this knowledge to do variations of different things on my own later – james Jan 08 '19 at 10:24
  • I refreshed my coding and edited my initial question (above) to take on your advice, including the length and tried to tackle point 3 and 4 but the macro is still to no avail... Could you teach me how I could fix this? I used offset (1,1) which will move my cursor to the cell (1 step right to the column with a value match), but doesnt run – james Jan 08 '19 at 10:49
  • Why are you still copuing and pasting in `Range(rng).Select.Copy`. I already showed you how to do that in 1 line? – Siddharth Rout Jan 08 '19 at 10:54
  • you mean the .Columns(rng.Column).Value = .Columns(rng.Column).Value? I cannot use this because (1) there are formula in this column that needs to remain as formula – james Jan 08 '19 at 11:23
  • `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` Do you have multiple table one below the other? – Siddharth Rout Jan 08 '19 at 11:34
  • So on each column (G to Z), I have formulas from G1:Z10, Row 11 is header and below that row are data. One Calc_2, I also have new table with formulas and headers starting row 100000 which is why I wanted to use those methods rather than the one you suggested above – james Jan 09 '19 at 02:06