Quantcast
Channel: General Office Development forum
Viewing all articles
Browse latest Browse all 2257

Row and Columns not working correctly

$
0
0

I have an excel sheet that has data in row A. I am trying to move all the data into two columns in word.

The first column is working perfectly and will put all the data in it. The second column however puts the same data in all rows and runs through every row in the excel spread sheet. Can someone explain to me why this is happening?

here is the entire code, I have bolded the section that I am having some trouble with

                     

Sub Drawings()


Dim WordApp As Word.Application
Dim oDoc As Word.Document
Dim myRange As Word.Range
Dim RowCount
Dim RowNumber
Dim Row

RowCount = Application.CountA(Range("A:A"))
RowNumber = Round(RowCount / 2)

Set WordApp = CreateObject("Word.Application") ' creates the Woord Applications
WordApp.Visible = True ' allows the word window to be open

Set oDoc = WordApp.Documents.Add ' WordDoc is the variable to edit the document

Set otable = oDoc.Tables.Add( _
    Range:=oDoc.Range(Start:=0, End:=0), NumRows:=RowNumber + 1, _
    NumColumns:=3) ' adds a table with three columns and spe

oDoc.Tables(1).Columns(1).SetWidth ColumnWidth:=WordApp.InchesToPoints(4), RulerStyle:=wdAdjustNone ' sets column 1 to 4 inches
oDoc.Tables(1).Columns(2).SetWidth ColumnWidth:=WordApp.InchesToPoints(0.19), RulerStyle:=wdAdjustNone ' sets column 2 to .2 inches
oDoc.Tables(1).Columns(3).SetWidth ColumnWidth:=WordApp.InchesToPoints(4), RulerStyle:=wdAdjustNone ' sets column 3 to 4 inches


With otable
.Rows.HorizontalPosition = WordApp.InchesToPoints(-0.75) ' shifts labels left on the page
End With


 'Loop through columns and rows
   For iRow = 1 To RowNumber
    For iCol = 1 To 1 ' takes data from column 1
        With Worksheets("Sheet1").Cells(iRow, iCol)
            otable.Rows(iRow).Cells(1).Range.Text = .Value
        End With
    Next iCol
    Next iRow

  For iRow = RowNumber + 1 To RowCount
     For iCol = 1 To 1 ' takes data from column 1
       For Row = 1 To RowNumber
            With Worksheets("Sheet1").Cells(iRow, iCol)
            otable.Rows(Row).Cells(3).Range.Text = .Value
        End With

    Next Row
    Next iCol
    Next iRow



    WordApp.Selection.WholeStory ' selects the entire table
    WordApp.Selection.Font.Bold = wdToggle ' bolds the text
    WordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter 'center aligns everything
    WordApp.Selection.Font.Size = 14
    oDoc.Tables(1).Rows.HeightRule = wdRowHeightExactly ' ensures row height is exact
    oDoc.Tables(1).Rows.Height = WordApp.InchesToPoints(1) ' sets all rows to 1 inch

End Sub

Thanks!


Viewing all articles
Browse latest Browse all 2257

Trending Articles