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


[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[TD]G[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]PHMD[/TD]
[TD]API[/TD]
[TD]MD[/TD]
[TD]INC[/TD]
[TD]AZM[/TD]
[TD]DLS[/TD]
[TD]MDLS[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]7803[/TD]
[TD]1234[/TD]
[TD]7803[/TD]
[TD]13[/TD]
[TD]345[/TD]
[TD]10[/TD]
[TD]12[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]7804[/TD]
[TD]1234[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]7805[/TD]
[TD]1234[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]7806[/TD]
[TD]1234[/TD]
[TD]7806[/TD]
[TD]34[/TD]
[TD]350[/TD]
[TD]7[/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]7807[/TD]
[TD]1234[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]7808[/TD]
[TD]1234[/TD]
[TD]7808[/TD]
[TD]60[/TD]
[TD]355[/TD]
[TD]11[/TD]
[TD]13[/TD]
[/TR]
</tbody>[/TABLE]







Table after script is ran


[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[TD]G[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]PHMD[/TD]
[TD]API[/TD]
[TD]MD[/TD]
[TD]INC[/TD]
[TD]AZM[/TD]
[TD]DLS[/TD]
[TD]MDLS[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]7803[/TD]
[TD]1234[/TD]
[TD]7803[/TD]
[TD]13[/TD]
[TD]345[/TD]
[TD]10[/TD]
[TD]12[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]7804[/TD]
[TD]1234[/TD]
[TD]7804[/TD]
[TD]20[/TD]
[TD]346.66[/TD]
[TD]10[/TD]
[TD]12[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]7805[/TD]
[TD]1234[/TD]
[TD]7805[/TD]
[TD]27[/TD]
[TD]348.33[/TD]
[TD]10[/TD]
[TD]12[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]7806[/TD]
[TD]1234[/TD]
[TD]7806[/TD]
[TD]34[/TD]
[TD]350[/TD]
[TD]7[/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]7807[/TD]
[TD]1234[/TD]
[TD]7807[/TD]
[TD]47[/TD]
[TD]352.5[/TD]
[TD]7[/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]7808[/TD]
[TD]1234[/TD]
[TD]7808[/TD]
[TD]60[/TD]
[TD]355[/TD]
[TD]11[/TD]
[TD]13[/TD]
[/TR]
</tbody>[/TABLE]

 

[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