PDA

View Full Version : Seeking help to make cell ranges dynamic



Azur
02-24-2020, 05:45 PM
The current shown below works. The only problem I have to continually go into the code to change the values of the cells because the data in the worksheet A21 change daily.

I found a found a script on the Internet I am trying to modify to suit my need. But I am running into trouble as you can see in the attachment.
The range cells involved are the following:
Set rng = Worksheets("A21Cals").Range("b3:k7", "b10:k15")
Set tng = Worksheets("A21Cals").Range("b18:k26", "b29:k32")

On transferring (or pasting only) the data the range cells are:
Worksheets("A21Cals").Range("l3", "l10").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value

Worksheets("A21Cals").Range("l19", "l27").Resize(tng.Rows.Count, tng.Columns.Count).Cells.Value = tng.Cells.Value

I would to make these range of cells dynamic so that as the data in A21 change the ranges adjust in rows and columns sizes to reflect to new data.
I just cannot figure out how to to do that.

Azur

Current script

Dim rng As Range

'Grab Some Data and Store it in a "Range" variable
Set rng = Worksheets("A21Cals").Range("b3:k7", "b10:k16")
Set tng = Worksheets("A21Cals").Range("b19:k24", "b27:k27")

'Transfer Values to same spot in another worksheet (Mimics PasteSpecial Values Only)
Worksheets("A21Cals").Range("l3", "l10").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
Cells.WrapText = False
SkipBlanks _
= False

Worksheets("A21Cals").Range("l19", "l27").Resize(tng.Rows.Count, tng.Columns.Count).Cells.Value = tng.Cells.Value
Cells.WrapText = False
SkipBlanks _
= False

'Call SelectBlanks
End Sub

SamT
02-24-2020, 10:02 PM
I wonder how the worksheet is structured.
IOW, If I was looking at the sheet, how can I tell where one range starts and another ends?

Azur
02-25-2020, 05:04 PM
I am sorry I have not provided the structure of the worksheet when I posted my request. In a nutshell here the data as it appears in a table (see attachment).

I colored purposely half of the table in light bluish color. The data in this half are linked through formulas to a Pivot table. The vba script copy and paste the data (just the data not formula) to the other half (right side).

The problem as I stated in my first post, the data coming from the pivot table change daily and consequently the rows in the left side side change as well. To ensure the data are captured from the Pivot table, I have to manually insert rows above each bar and drag down until all data from the Pivot table are captured. Then I manually delete rows that do not have data. See the example in the empty rows in the "Accepted Values" area.

The bars are the merged rows. They are "Proposed Values", "Accepted Values", "Implemented Values", and after the last row of data in the implemented Values section)

The next step is to go into the code and change the cells coordinates or address.

In this instance, the cells address are:

Set rng = Worksheets("A21Cals").Range("b3:k7", "b10:k15")
Set tng = Worksheets("A21Cals").Range("b18:k26", "b29:k32")

Data are copied in the following:

Worksheets("A21Cals").Range("l3", "l7").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value

Worksheets("A21Cals").Range("l18", "l29").Resize(tng.Rows.Count, tng.Columns.Count).Cells.Value = tng.Cells.Value

I added the following to prevent data overflow
Cells.WrapText = False

I am not sure if the "SkipBlanks _
= False" line works.

================================
The Code
================================
Sub DataValues()

Dim rng As Range

'Grab Some Data and Store it in a "Range" variable
Set rng = Worksheets("A21Cals").Range("b3:k7", "b10:k15")
Set tng = Worksheets("A21Cals").Range("b18:k26", "b29:k32")

'Transfer Values to same spot in another worksheet (Mimics PasteSpecial Values Only)
Worksheets("A21Cals").Range("l3", "l10").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
'Prevent text wrapping from occuring in the range
Cells.WrapText = False
SkipBlanks _
= False

Worksheets("A21Cals").Range("l18", "l29").Resize(tng.Rows.Count, tng.Columns.Count).Cells.Value = tng.Cells.Value
'Prevent text wrapping from occuring in the range
Cells.WrapText = False
SkipBlanks _
= False

'Call SelectBlanks
End Sub

26084

Paul_Hossler
02-25-2020, 05:56 PM
It'd be more helpful if you attached a workbook (sanitize any necessary data) with a description of what you wanted to do as applied to that workbook

Azur
02-25-2020, 06:57 PM
Here is the a stripped version of Excel Spreadsheet