Simpler Conditional Row Creation

[PaulAsaran]

I'm currently working on a project intended to simplify the user interface for a table. This table can run in the hundreds of rows and as-is these need to be entered manually line-by-line. We want to create a system in which the table will fill most of its lines based on the information of a smaller initial table.

The smaller table has a column of ascending values and appropriate known data for those values:

From	Iteration	Data
0	100	3
500	50	0
1000	100	3

<tbody>
</tbody>

What I want is for the new table to have built-in calculations that build the values based on the above table. The key element is to have each table iterate its values based upon what is seen above:

Distance	Data
0	3
100	6
200	9
300	12
400	15
500	18
550	18
600	18
650	18

<tbody>
</tbody>

Right now I plan to use a simple VLOOKUP function to determine iterations and data. The problem I'm running into is getting the iterations into the first column. Row B needs to look at Row A and know where that value falls in the first table (i.e., 300 is between 0 and 500, so iterate by 100 and raise the data by 3; 600 is between 500 and 1000, so iterate by 50 and don't raise the data). I could use a series of IF statements to make the comparison, but the first table is going to be 20 rows long. That's a lot of IF/VLOOKUP statements and tons of room for error, plus updating it in the future would be a chore. Also bear in mind that the values in the first table will change from project to project, so the conditions in the statement need to be cell-based, not constant.

Is there a simple method to do this without a wall of IF statements?

 

[Special-K99]

There's no indication of when the data stops.
In your last line start at 1000, keep adding 100 to the distance, keep adding 3 to the Data.
Until when... ?
There's no finsihing number for the 1000 to stop at.

Or will there only be one occurrence of 1000 as the last row ?

Try this

Sub k1()
lastrow = Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
m = 1
For i = 1 To lastrow
j = Cells(i, 1)
k = Cells(i, 2)
l = Cells(i, 3)
n = n + l
For o = j To Cells(i + 1, 1) Step k
Cells(m, 5) = o
Cells(m, 6) = n
n = n + l
m = m + 1
Next o
n = n - l
Next i
End Sub

 

[MickG]

Try this for results starting "E1"

[COLOR="Navy"]Sub[/COLOR] MG11Feb49
[COLOR="Navy"]Dim[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] St [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] s [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Tot [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Dt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Lst = Range("A" & Rows.Count).End(xlUp).Row
Range("E1:F1").Value = Array("Distance", " Data")
c = 1
[COLOR="Navy"]For[/COLOR] n = 2 To Lst - 1
St = Cells(n, 2): Dt = Cells(n, 3)
    [COLOR="Navy"]For[/COLOR] s = Cells(n, 1) To Cells(n + 1, 1) [COLOR="Navy"]Step[/COLOR] St
        c = c + 1
        [COLOR="Navy"]If[/COLOR] c = 2 [COLOR="Navy"]Then[/COLOR]
            Cells(c, "E") = Cells(n, 1)
            Cells(c, "F") = Cells(n, 3)
        [COLOR="Navy"]Else[/COLOR]
            Cells(c, "E") = Cells(c - 1, "E") + St
            Cells(c, "F") = Cells(c - 1, "F") + Dt
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] s
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[PaulAsaran]

There's no indication of when the data stops.
In your last line start at 1000, keep adding 100 to the distance, keep adding 3 to the Data.
Until when... ?
There's no finsihing number for the 1000 to stop at.

Or will there only be one occurrence of 1000 as the last row ?

Try this

Sub k1()
lastrow = Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
m = 1
For i = 1 To lastrow
j = Cells(i, 1)
k = Cells(i, 2)
l = Cells(i, 3)
n = n + l
For o = j To Cells(i + 1, 1) Step k
Cells(m, 5) = o
Cells(m, 6) = n
n = n + l
m = m + 1
Next o
n = n - l
Next i
End Sub

Excuse me while I facepalm.

I simplified the original table in hopes of keeping things from getting confusing. I should have known better. Let me offer the actual table:

From	To	Interval	Data
0	500	100	8
500	1000	100	5
1000	1500	50	2
1500	2000	100	0
2000	2500	100	5
2500	3000	100	0

<tbody>
</tbody>

So essentially, the final number listed in the "to" column would be the target of the end of the data. How might this affect your solution?

Bear in mind that the number of rows actually used in the first table is variable. While the table itself is 20 rows long, there may only be 7 rows used, so the location of the final number in the "to" column isn't constant from project to project.

Try this for results starting "E1"

[COLOR=Navy]Sub[/COLOR] MG11Feb49
[COLOR=Navy]Dim[/COLOR] Lst [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] St [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] s [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] c [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Tot [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Dt [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
Lst = Range("A" & Rows.Count).End(xlUp).Row
Range("E1:F1").Value = Array("Distance", " Data")
c = 1
[COLOR=Navy]For[/COLOR] n = 2 To Lst - 1
St = Cells(n, 2): Dt = Cells(n, 3)
    [COLOR=Navy]For[/COLOR] s = Cells(n, 1) To Cells(n + 1, 1) [COLOR=Navy]Step[/COLOR] St
        c = c + 1
        [COLOR=Navy]If[/COLOR] c = 2 [COLOR=Navy]Then[/COLOR]
            Cells(c, "E") = Cells(n, 1)
            Cells(c, "F") = Cells(n, 3)
        [COLOR=Navy]Else[/COLOR]
            Cells(c, "E") = Cells(c - 1, "E") + St
            Cells(c, "F") = Cells(c - 1, "F") + Dt
        [COLOR=Navy]End[/COLOR] If
    [COLOR=Navy]Next[/COLOR] s
[COLOR=Navy]Next[/COLOR] n
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

Regards Mick

Would the conditions I mentioned above change your solution in any way?



Please bear in mind that I only have the barest grasp of VBA, so I may have difficulty implementing these solutions.

 

[MickG]

Try this for Data in columns "A to D" and for Results starting "E1".

[COLOR="Navy"]Sub[/COLOR] MG12Feb33
[COLOR="Navy"]Dim[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] St [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] s [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] nRng [COLOR="Navy"]As[/COLOR] Range, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Dt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Lst = Range("A" & Rows.Count).End(xlUp).Row
Range("E1:F1").Value = Array("Distance", " Data")
c = 1
[COLOR="Navy"]For[/COLOR] n = 2 To Lst
St = Cells(n, 3)
    [COLOR="Navy"]For[/COLOR] s = Cells(n, 1) To (Cells(n, 2) - Cells(n, 3)) [COLOR="Navy"]Step[/COLOR] St
        c = c + 1
        [COLOR="Navy"]If[/COLOR] c = 2 [COLOR="Navy"]Then[/COLOR]
            Cells(c, "E") = Cells(n, 1)
        [COLOR="Navy"]Else[/COLOR]
            Cells(c, "E") = s
        [COLOR="Navy"]End[/COLOR] If
           [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] nRng = Cells(c, "E") Else _
           [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Cells(c, "E"))
    [COLOR="Navy"]Next[/COLOR] s
[COLOR="Navy"]Next[/COLOR] n


[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range("A2", Range("A" & Rows.Count).End(xlUp))

[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng: .Item(Dn.Value) = Dn.Offset(, 3).Value: [COLOR="Navy"]Next[/COLOR] Dn
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] nRng
            [COLOR="Navy"]If[/COLOR] Dn.Address = nRng(1).Address [COLOR="Navy"]Then[/COLOR]
                Dn.Offset(, 1).Value = [d2]
            [COLOR="Navy"]Else[/COLOR]
                Dn.Offset(, 1).Value = Dn.Offset(-1, 1).Value + Dt
            [COLOR="Navy"]End[/COLOR] If
                [COLOR="Navy"]If[/COLOR] .exists(Dn.Value) [COLOR="Navy"]Then[/COLOR] Dt = .Item(Dn.Value)
    [COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] With

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

Regards Mick

 

[PaulAsaran]

Had to tweak it for cell location, but it worked. Many thanks!

Now I just have to figure out what all that means so I can replicate it in the future. Time to do some research.

 

[MickG]

You're welcome
Below is a shorter version of the code giving the same result.

[COLOR="Navy"]Sub[/COLOR] MG12Feb06
[COLOR="Navy"]Dim[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] St [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] s [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] nRng [COLOR="Navy"]As[/COLOR] Range, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Num [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Lst = Range("A" & Rows.Count).End(xlUp).Row
Range("E1:F1").Value = Array("Distance", " Data")
c = 1
[COLOR="Navy"]For[/COLOR] n = 2 To Lst
St = Cells(n, 3)
    [COLOR="Navy"]For[/COLOR] s = Cells(n, 1) To (Cells(n, 2) - Cells(n, 3)) [COLOR="Navy"]Step[/COLOR] St
        c = c + 1
        [COLOR="Navy"]If[/COLOR] c = 2 [COLOR="Navy"]Then[/COLOR]
           [COLOR="Navy"]If[/COLOR] Cells(n, 1) = s [COLOR="Navy"]Then[/COLOR] Num = Cells(n, 4)
            Cells(c, "E") = Cells(n, 1)
            Cells(c, "F") = Num
        [COLOR="Navy"]Else[/COLOR]
            Cells(c, "E") = s
            Cells(c, "F") = Cells(c - 1, "F") + Num
        [COLOR="Navy"]End[/COLOR] If
          [COLOR="Navy"]If[/COLOR] Cells(n, 1) = s [COLOR="Navy"]Then[/COLOR] Num = Cells(n, 4)
    [COLOR="Navy"]Next[/COLOR] s
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick