Thread: Programming Automated Tables

I'm experienced in Excel, but macros are very new to me. I've been somewhat successful in developing a code that will make a few of my work functions a whole lot simpler. My codes are clunky and there might be a better way to go about it, but it works and it is helping save us hours every day.

I created two macros to achieve my objective. I used the "record a macro" function, which probably creates very ugly codes. My first code formats raw data in a certain fashion so that it can be easily extracted; I understand this code fairly well and have been able to make alterations to it with ease.

The second macro takes values from the formatted data and plugs them into a table. Unfortunately, the code that Excel wrote is very confusing to me.

Essentially, the data follows a pattern (new entries occur every 14 rows), but Excel's automated code is tedious to program. Here's an example:

Columns("R:R").Select
With Selection.Interior
.ColorIndex = 11
.Pattern = xlSolid
End With
Range("T2").Select
ActiveCell.FormulaR1C1 = "Acct"
Range("U2").Select
ActiveCell.FormulaR1C1 = "Org Name"
Range("V2").Select
ActiveCell.FormulaR1C1 = "Pmt Type"
Range("W2").Select
ActiveCell.FormulaR1C1 = "Due Date"
Range("X2").Select
ActiveCell.FormulaR1C1 = "Sub"
Range("Y2").Select
ActiveCell.FormulaR1C1 = "Total"
Range("Y3").Select
Range("T3").Select
ActiveCell.FormulaR1C1 = "=R[-1]C[-19]"
Range("U3").Select
ActiveCell.FormulaR1C1 = "=R[-1]C[-16]"
Range("U4").Select
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
Range("V3").Select
ActiveCell.FormulaR1C1 = "=RC[-16]"
Range("W3").Select
ActiveCell.FormulaR1C1 = "=R[5]C[-17]"
Range("W4").Select
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
Range("X3").Select
ActiveCell.FormulaR1C1 = "=R[10]C[-22]"
Range("X4").Select
ActiveWindow.SmallScroll ToRight:=3
Range("Y3").Select
ActiveCell.FormulaR1C1 = "=R[10]C[-22]"
Range("T4").Select
ActiveCell.FormulaR1C1 = "=R[12]C[-19]"
Range("U4").Select
ActiveCell.FormulaR1C1 = "=R[12]C[-16]"
Range("U5").Select
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
Range("V4").Select
ActiveCell.FormulaR1C1 = "=R[13]C[-16]"
Range("V5").Select
ActiveWindow.ScrollColumn = 5
Range("W4").Select
ActiveCell.FormulaR1C1 = "=R[18]C[-17]"
Range("W5").Select
ActiveWindow.ScrollColumn = 6
Range("X4").Select
ActiveCell.FormulaR1C1 = "=R[23]C[-22]"
Range("X5").Select
ActiveWindow.ScrollColumn = 7
Range("Y4").Select
ActiveCell.FormulaR1C1 = "=R[23]C[-22]"
Range("T5").Select
ActiveCell.FormulaR1C1 = ""
Range("T5").Select
ActiveCell.FormulaR1C1 = "=R[25]C[-19]"
Range("U5").Select
ActiveCell.FormulaR1C1 = "=R[25]C[-16]"
Range("V5").Select
ActiveCell.FormulaR1C1 = "=R[26]C[-16]"
Range("W5").Select
ActiveCell.FormulaR1C1 = "=R[31]C[-17]"
Range("X5").Select
ActiveCell.FormulaR1C1 = "=R[36]C[-22]"
Range("Y5").Select
ActiveCell.FormulaR1C1 = "=R[36]C[-22]"
Range("T6").Select
ActiveCell.FormulaR1C1 = "=R[38]C[-19]"
Range("U6").Select
ActiveCell.FormulaR1C1 = "=R[38]C[-16]"
Range("V6").Select
ActiveCell.FormulaR1C1 = "=R[39]C[-16]"
Range("W6").Select
ActiveCell.FormulaR1C1 = "=R[44]C[-17]"
Range("X6").Select
ActiveCell.FormulaR1C1 = "=R[49]C[-22]"
Range("X6").Select
Selection.AutoFill Destination:=Range("X6:Y6"), Type:=xlFillDefault
Range("X6:Y6").Select
Range("T7").Select
ActiveCell.FormulaR1C1 = "=R[51]C[-19]"
Range("U7").Select
ActiveCell.FormulaR1C1 = "=R[51]C[-16]"
Range("V7").Select
ActiveCell.FormulaR1C1 = "=R[52]C[-16]"
Range("W7").Select
ActiveCell.FormulaR1C1 = ""
Range("W7").Select
ActiveCell.FormulaR1C1 = "=R[57]C[-17]"
Range("X7").Select
ActiveCell.FormulaR1C1 = "=R[62]C[-22]"
Range("X7").Select
Selection.AutoFill Destination:=Range("X7:Y7"), Type:=xlFillDefault
Range("X7:Y7").Select
Range("T8").Select
ActiveCell.FormulaR1C1 = "=R[64]C[-19]"
Range("U8").Select
ActiveCell.FormulaR1C1 = "=R[64]C[-16]"
Range("V8").Select
ActiveCell.FormulaR1C1 = "=R[65]C[-16]"
Range("W8").Select
ActiveCell.FormulaR1C1 = "=R[70]C[-17]"
Range("X8").Select
ActiveCell.FormulaR1C1 = "=R[75]C[-22]"
Range("Y8").Select
ActiveCell.FormulaR1C1 = "=R[75]C[-22]"
Range("T9").Select
ActiveCell.FormulaR1C1 = "=R[77]C[-19]"
Range("U9").Select
ActiveCell.FormulaR1C1 = "=R[77]C[-16]"
Range("V9").Select
ActiveCell.FormulaR1C1 = "=R[78]C[-16]"
Range("W9").Select
ActiveCell.FormulaR1C1 = "=R[83]C[-17]"
Range("X9").Select
ActiveCell.FormulaR1C1 = "=R[88]C[-22]"
Range("Y9").Select
ActiveCell.FormulaR1C1 = "=R[88]C[-22]"
Range("T10").Select
ActiveCell.FormulaR1C1 = "=R[90]C[-19]"
Range("U10").Select
ActiveCell.FormulaR1C1 = "=R[90]C[-16]"
Range("V10").Select
ActiveCell.FormulaR1C1 = "=R[91]C[-16]"
Range("W10").Select
ActiveCell.FormulaR1C1 = "=R[96]C[-17]"
Range("X10").Select
ActiveCell.FormulaR1C1 = "=R[101]C[-22]"
Range("Y10").Select
ActiveCell.FormulaR1C1 = "=R[101]C[-22]"
Range("T11").Select
ActiveCell.FormulaR1C1 = "=R[103]C[-19]"
Range("U11").Select
ActiveCell.FormulaR1C1 = "=R[103]C[-16]"
Range("V11").Select
ActiveCell.FormulaR1C1 = "=R[104]C[-16]"

Essentially, the table has six columns. Each row represents data from one account. The account entries comprise 14 rows, so if my first entry for "Acct #" is in cell "A1", then my second entry will be in cell "A15".

I can see what Excel did. It counts the number of rows down (i.e. "R[116]) and columns over (i.e. "C[-19]), but this makes it very tedious to expand the code in order to expand my table since I have to count down and over for each cell.

Is there a simpler way to code this so that all I have to do is plug in cell numbers (rather than counting downwards and over to arrive at the destination cells)?

For that matter, is there a simpler way to write this Excel code? Excel does not seem to recognize my patterns, which is why I had to enter the data for this the slow way.


Any help on making this process simpler is appreciated.

Yes, there are simpler ways...

Can you please upload a sample file with the actual layout?
This will make it much easier for us to help you because we can see the context (& even test our suggested code quickly) which may give you an answer in 1-2 posts instead of a dozen or so.

Rob

Code:

Sub XX()

    Dim lngRow As Long
    Dim lngOutRow As Long
    Dim lngOutCol As Long
    Dim rngCell As Range
    
    Range("T2:Y2") = Array("Acct", "Org Name", "Pmt Type", "Due Date", "Sub Total")
    lngRow = 1
    lngOutRow = 3
    Do While Len(Cells(lngRow, 1).Value) > 0
        lngOutCol = 20
        For Each rngCell In Cells(lngRow, 1).Range("A2,E2,F3,F8,B13,C13")
            Cells(lngOutRow, lngOutCol) = rngCell
            lngOutCol = lngOutCol + 1
        Next
        lngOutRow = lngOutRow + 1
        lngRow = lngRow + 14
    Loop
    
End Sub

Thanks so much! That worked perfectly.

Ok, so now that I know that I can make that loop, I guess my next question is how do I make the first part of this macro loop (the formatting aspect)?

The code that Excel cooked up for it looks like this:

Range("A1:A2").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(7, 1), Array(13, 1), Array(26, 1), Array(42, 1)), _
TrailingMinusNumbers:=True
Range("A3:A14").Select
Selection.TextToColumns Destination:=Range("A3"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1)), TrailingMinusNumbers:= _
True

Rather than looping, the code repeats itself itself over and over again, only with different ranges, so the next section would look like this:

Range("A15:A16").Select
Selection.TextToColumns Destination:=Range("A15"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(7, 1), Array(13, 1), Array(26, 1), Array(42, 1)), _
TrailingMinusNumbers:=True
Range("A17:A28").Select
Selection.TextToColumns Destination:=Range("A17"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1)), TrailingMinusNumbers:= _
True

The code is supposed to do Text to Columns on rows 1-2 using Fixed Width (you can see the exact locations of the breaks in the code). Then, it does rows 3-14 with Text to Columns, as well, but this time with Tab and Space delimiters. This patterns repeats itself in most of the data we have.

I'm looking at your code for the table, trying to figure out how I can apply it to the formatting macro, but I still don't understand some of the commands.

No data to test but this should work.

Code:

Sub x()

    Dim lngRow As Long
    
    lngRow = 1
    Do While Len(Cells(lngRow, 1)) > 0
        Cells(lngRow, 1).Resize(2, 1).Select
        Selection.TextToColumns Destination:=Cells(lngRow, 1), DataType:=xlFixedWidth, _
                    FieldInfo:=Array(Array(0, 1), Array(7, 1), Array(13, 1), Array(26, 1), Array(42, 1)), _
                    TrailingMinusNumbers:=True
        Cells(lngRow + 2, 1).Resize(12, 1).Select
        Selection.TextToColumns Destination:=Cells(lngRow + 1, 1), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
                Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
                :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
                Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
                ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1)), TrailingMinusNumbers:= _
                True
        lngRow = lngRow + 14
    Loop
    
End Sub

Should have been a +2 in the destination cell not +1

Code:

        Selection.TextToColumns Destination:=Cells(lngRow + 2, 1), DataType:=xlDelimited, _

Actually, one minor question ---

Your code seems to be grabbing the right information and formatting the raw data correctly, but strangely, Excel pops out the "Due Date" column in the table with incorrect numbers.

Instead of getting "10/2/2009" for every entry on that column, I get "40088". It appears that instead of reading "10/2/2009" as a date, Excel reads it as something else (I'm not quite sure what).

[Edit: It does appear that all I have to do is change the format on all the numbers and they automatically convert to the date]

That number is the numeric value for the date 2-Oct-2009.
So setting date format is the way to resolve it.