VBA to copy/fill columns

[hissonrr]

Could anyone help me out with a script to fill cells from columns of data


I am not 100% sure how to describe it.

Basically I need to fill column C, D, and E, by series fill down based on on trend. Then column F and G I need to fill by copying the last known value down.


For example....


Initial table

	A	B	C	D	E	F	G
1	PHMD	API	MD	INC	AZM	DLS	MDLS
2	7803	1234	7803	13	345	10	12
3	7804	1234
4	7805	1234
5	7806	1234	7806	34	350	7	8
6	7807	1234
7	7808	1234	7808	60	355	11	13

<tbody>
</tbody>

Table after script is ran

	A	B	C	D	E	F	G
1	PHMD	API	MD	INC	AZM	DLS	MDLS
2	7803	1234	7803	13	345	10	12
3	7804	1234	7804	20	346.66	10	12
4	7805	1234	7805	27	348.33	10	12
5	7806	1234	7806	34	350	7	8
6	7807	1234	7807	47	352.5	7	8
7	7808	1234	7808	60	355	11	13

<tbody>
</tbody>

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG28Sep21
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, col [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Td [COLOR="Navy"]As[/COLOR] Double, R [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]For[/COLOR] col = 3 To 7
[COLOR="Navy"]On[/COLOR] [COLOR="Navy"]Error[/COLOR] [COLOR="Navy"]Resume[/COLOR] [COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Cells(2, col), Cells(Rows.Count, col).End(xlUp)).SpecialCells(xlCellTypeBlanks)
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.Areas
        Td = IIf(col < 6, (Dn(Dn.Count).Offset(1) - Dn(1).Offset(-1)) / (Dn.Count + 1), Dn(1).Offset(-1))
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] Dn
            R.Value = IIf(col < 6, Format(R.Offset(-1).Value + Td, "0.00"), Td)
        [COLOR="Navy"]Next[/COLOR] R
    [COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]Next[/COLOR] col
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[hissonrr]

No it doesn't work or do anything.

It may be my fault as i should have explained all the cells in the table do have a formula in them and that may effect why the above didn't work properly.

For example all my cells in D have... Since I need them to pull data from a table (table name = Curve)

{=IFERROR(INDEX(Curve,MATCH(1,(A2<=Curve[Measured Depth])*(A3>Curve[Measured Depth]),0),7),"")}

 

[MickG]

This code will find the cells whose formula equates to "" then remove the formula and replace it with the data trend value.
NB:- This code will only work where there is a value at the top and bottom of each blank range !!!

[COLOR="Navy"]Sub[/COLOR] MG29Sep07
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, col [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Td [COLOR="Navy"]As[/COLOR] Double, R [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Cells(1).CurrentRegion
    [COLOR="Navy"]If[/COLOR] Dn.HasFormula [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]If[/COLOR] Dn.Value = "" [COLOR="Navy"]Then[/COLOR]
            Dn.Value = Dn.Value
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]For[/COLOR] col = 3 To 7
[COLOR="Navy"]On[/COLOR] [COLOR="Navy"]Error[/COLOR] [COLOR="Navy"]Resume[/COLOR] [COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Cells(2, col), Cells(Rows.Count, col).End(xlUp)).SpecialCells(xlCellTypeBlanks)
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.Areas
        Td = IIf(col < 6, (Dn(Dn.Count).Offset(1) - Dn(1).Offset(-1)) / (Dn.Count + 1), Dn(1).Offset(-1))
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] Dn
            R.Value = IIf(col < 6, Format(R.Offset(-1).Value + Td, "0.00"), Td)
        [COLOR="Navy"]Next[/COLOR] R
    [COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]Next[/COLOR] col

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[hissonrr]

Worked perfectly thanks Mick

 

[MickG]

You're welcome