So infuriating!!! Placing values into cells works except for last row

R

rogerbowering

New Member
Joined
Apr 29, 2013
Messages
14
Hi

I have a dataset from a relational database that I ma using Excel VBA to format from one worksheet to another

I take the raw export data and depending on whether it's header or child record data I format it a certain way in the worksheet

I've two worksheets 'Export' where the Database dataset is exported to and 'Report' where I'm copying formatted data into using VBA

So....I loop through and reformat the cells

As I go through the 'child' data the cells always copy over EXCEPT the last record!!! And I can't figure why. My VBA is crude but every 'child' record gets copied from one sheet to the other using:
Code: 
            Sheets("Export").Select
            HistDate = Cells(Row, 8)
            Updater = Cells(Row, 9)
            notes = Cells(Row, 10)
            HistStatus = Cells(Row, 11)
            ActionWith = Cells(Row, 12)
            CompletionDate = Cells(Row, 13)
            'RptRow = RptRow + 1
            'Sheets("Headings").Select
            'Range("A2:H2").Select
            'Selection.Copy
            'Sheets("Report").Select
            'RangeCalc = "A" & RTrim(RptRow)
            'Cells(RptRow, 1).Select
            'ActiveSheet.Paste
            Sheets("Report").Select
            RptRow = RptRow + 1
            Cells(RptRow, 2) = HistDate
            Cells(RptRow, 3) = Updater
            Cells(RptRow, 4) = notes
            Cells(RptRow, 5) = HistStatus
            Cells(RptRow, 6) = ActionWith
            Cells(RptRow, 7) = CompletionDate
            End If
            Row = Row + 1
When I'm debugging I can watch the last child record being processed and the data is going into the variables ok but it isn't going in to the cells in the 'Report' sheet. It's always the last child record, so I have a beautifully formatted Report missing one child record in every record set

Grrrrrrrrrrrrrrrrrrr
 
Last edited by a moderator:

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Sort by date Sort by votes
I suspect we need to see more of the code (such as what the start of the If clause is) to figure that out, but there is no need to select sheets:
Code: 
   With Sheets("Export")
      HistDate = .Cells(Row, 8).Value
      Updater = .Cells(Row, 9).Value
      Notes = .Cells(Row, 10).Value
      HistStatus = .Cells(Row, 11).Value
      ActionWith = .Cells(Row, 12).Value
      CompletionDate = .Cells(Row, 13).Value
   End With
   With Sheets("Report")
      RptRow = RptRow + 1
      .Cells(RptRow, 2).Value = HistDate
      .Cells(RptRow, 3).Value = Updater
      .Cells(RptRow, 4).Value = Notes
      .Cells(RptRow, 5).Value = HistStatus
      .Cells(RptRow, 6).Value = ActionWith
      .Cells(RptRow, 7).Value = CompletionDate
   End With
End If
Row = Row + 1
 
Upvote 0
RoryA said:
I suspect we need to see more of the code (such as what the start of the If clause is) to figure that out...
Click to expand...

Agreed


RoryA said:
...but there is no need to select sheets:
Code: 
   With Sheets("Export")
      HistDate = .Cells(Row, 8).Value
      Updater = .Cells(Row, 9).Value
      Notes = .Cells(Row, 10).Value
      HistStatus = .Cells(Row, 11).Value
      ActionWith = .Cells(Row, 12).Value
      CompletionDate = .Cells(Row, 13).Value
   End With
   With Sheets("Report")
      RptRow = RptRow + 1
      .Cells(RptRow, 2).Value = HistDate
      .Cells(RptRow, 3).Value = Updater
      .Cells(RptRow, 4).Value = Notes
      .Cells(RptRow, 5).Value = HistStatus
      .Cells(RptRow, 6).Value = ActionWith
      .Cells(RptRow, 7).Value = CompletionDate
   End With
End If
Row = Row + 1
Click to expand...
Actually, given the contiguous arrangements of cells, there is no need for the two With/EndWith blocks nor most of those variables either...

Code: 
RptRow = RptRow + 1
Sheets("Report").Cells(RptRow, 2).Resize(, 6).Value = Sheets("Export").Cells(Row, 8).Resize(, 6).Value
Row = Row + 1
 
Last edited:
Upvote 0
Rory

Thanks for getting back. The code is pretty crude and the pre-Else statement is about checking whether I'm looking at a Master record or a child record

The incoming data looks like this (seriously abbreviated)
Master ID; Master Desc; Master Date; Child Date; Child Note; Child Action
12 I'm a Record 01/03/2013 12/05/2013 One child note Fred
13/05/2013 Second Child Note John
02/06/2013 Third Child Note Fred
20 I'm another 02/04/2013 02/04/2013 A Child Record John
03/04/2013 Another Child John
06/06/2013 A YThird John

and the output should be

12 I'm a Record 01/03/2013
12/05/2013 One child note Fred
13/05/2013 Second Child Note John
02/06/2013 Third Child Note Fred
20 I'm another 02/04/2013
02/04/2013 A Child Record John
03/04/2013 Another Child John
06/06/2013 A YThird John

....but using the above as an example, the third child record is always not copied over. The code is very crude

There are three worksheets:
Report where I want the final output to be
Export where the data comes from
Headings where I copy a header or subheader row over at ther appropriate time

The code (which includes lots of layout formatting from a macro):
Code: 
Sub ZurichDevLog()
Dim CaseID As Integer, Priority As Integer
Dim Topic As String, CaseStatus As String, SubTopic As String, Description As String
Dim Updater As String, notes As String, HistStatus As String, ActionWith As String
Dim DateRaised As Date, ModifiedDate As Date
Dim HistDate As Date, CompletionDate As Date
Dim MainHead As String, SubHead As String


'Import
    Workbooks.Open Filename:= _
        "C:\Users\roger.bowering\Documents\Dropbox\Work\MYI\Zurich Development\Excel Export.xlsx"
    With ActiveWindow
        .Top = 38.5
        .Left = 202
    End With
    Windows("Zurich Development Log.xlsm").Activate
    Sheets("Export").Select
    Cells.Select
    Selection.ClearContents
    Windows("Excel Export.xlsx").Activate
    Cells.Select
    Selection.Copy
    Windows("Zurich Development Log.xlsm").Activate
    ActiveSheet.Paste
    
'Rearrange Columns
    Sheets("Export").Select
    Columns("B:D").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("F:F").Select
    Selection.Cut
    Columns("B:B").Select
    ActiveSheet.Paste
    Columns("H:H").Select
    Selection.Cut
    Columns("C:C").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll ToRight:=2
    Columns("K:K").Select
    Selection.Cut
    ActiveWindow.LargeScroll ToRight:=-1
    Columns("D:D").Select
    ActiveSheet.Paste
    Columns("E:E").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("H:H").Select
    Selection.Cut
    Columns("E:E").Select
    ActiveSheet.Paste
    ActiveWindow.LargeScroll ToRight:=1
    Columns("N:N").Select
    Selection.Cut
    Application.CutCopyMode = False
    ActiveWorkbook.Save
    ActiveWindow.LargeScroll ToRight:=-1
    Columns("G:G").Select
    ActiveWindow.SmallScroll ToRight:=5
    Columns("M:M").Select
    Selection.Cut
    Columns("G:G").Select
    ActiveSheet.Paste
    Columns("H:M").Select
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.SmallScroll ToRight:=-3
    Columns("G:G").Select
    Selection.Cut
    Columns("E:E").Select
    ActiveSheet.Paste
    Columns("H:H").Select
    Selection.Cut
    Columns("G:G").Select
    ActiveSheet.Paste
    Columns("H:H").Select
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.SmallScroll ToRight:=4
    Columns("K:K").Select
    Selection.Delete Shift:=xlToLeft
    
'Clear Main Sheet
    Sheets("Report").Select
    Cells.Select
    Selection.ClearContents
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With


'Get and format Data
hdr = 0: Row = 2: Column = 1: RptRow = 1
Sheets("Export").Select
Varble = Cells(Row, 9)
While Cells(Row, 8) > ""
    If Cells(Row, 1) > 0 Then
            hdr = 1
            CaseID = Cells(Row, 1)
            Priority = Cells(Row, 6)
            Topic = Cells(Row, 2)
            CaseStatus = Cells(Row, 5)
            SubTopic = Cells(Row, 3)
            Description = Cells(Row, 4)
            ModifiedDate = Cells(Row, 7)
            HistDate = Cells(Row, 8)
            Updater = Cells(Row, 9)
            notes = Cells(Row, 10)
            HistStatus = Cells(Row, 11)
            ActionWith = Cells(Row, 12)
            CompletionDate = Cells(Row, 13)
            Sheets("Headings").Select
            Range("A1:H1").Select
            Selection.Copy
            Sheets("Report").Select
            RangeCalc = "A" & RTrim(RptRow)
            'Range("RangeCalc").Select
            Cells(RptRow, 1).Select
            ActiveSheet.Paste
            RptRow = RptRow + 1
            Cells(RptRow, 1) = CaseID
            Cells(RptRow, 6) = Priority
            Cells(RptRow, 2) = Topic
            Cells(RptRow, 5) = CaseStatus
            Cells(RptRow, 3) = SubTopic
            Cells(RptRow, 4) = Description
            Cells(RptRow, 7) = ModifiedDate
            RptRow = RptRow + 1
            Sheets("Headings").Select
            Range("A2:H2").Select
            Selection.Copy
            Sheets("Report").Select
            RangeCalc = "A" & RTrim(RptRow)
            Cells(RptRow, 1).Select
            ActiveSheet.Paste
            RptRow = RptRow + 1
            Cells(RptRow, 2) = HistDate
            Cells(RptRow, 3) = Updater
            Cells(RptRow, 4) = notes
            Cells(RptRow, 5) = HistStatus
            Cells(RptRow, 6) = ActionWith
            Cells(RptRow, 7) = CompletionDate


    Else
            Sheets("Export").Select
            HistDate = Cells(Row, 8)
            Updater = Cells(Row, 9)
            notes = Cells(Row, 10)
            HistStatus = Cells(Row, 11)
            ActionWith = Cells(Row, 12)
            CompletionDate = Cells(Row, 13)
            'RptRow = RptRow + 1
            'Sheets("Headings").Select
            'Range("A2:H2").Select
            'Selection.Copy
            'Sheets("Report").Select
            'RangeCalc = "A" & RTrim(RptRow)
            'Cells(RptRow, 1).Select
            'ActiveSheet.Paste
            Sheets("Report").Select
            RptRow = RptRow + 1
            Cells(RptRow, 2) = HistDate
            Cells(RptRow, 3) = Updater
            Cells(RptRow, 4) = notes
            Cells(RptRow, 5) = HistStatus
            Cells(RptRow, 6) = ActionWith
            Cells(RptRow, 7) = CompletionDate
            End If
            Row = Row + 1


    
    
           Sheets("Export").Select




Wend




'Format Document
Sheets("Report").Select
    Cells.Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlTop
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("K2").Select
    ActiveWindow.SmallScroll Down:=-6
    Columns("G:G").Select
    Selection.NumberFormat = "m/d/yyyy"
    ActiveWindow.SmallScroll Down:=-24
    Columns("H:H").ColumnWidth = 23
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "Comments"
    Range("H2").Select
    Columns("H:H").ColumnWidth = 29.43
End Sub
 
Last edited by a moderator:
Upvote 0
The examples I included are, of course, obliterated by html.
The rows
13/05/2013 Second Child Note John
02/06/2013 Third Child Note Fred
and
03/04/2013 Another Child John
06/06/2013 A YThird John
should be seriously to the right and under Child Date; Child Note; Child Action Headings

and the output of these same records are offset to the right by one column
 
Upvote 0
I think this is your problem:
Code: 
Cells(RptRow, 1).Select
ActiveSheet.Paste
RptRow = RptRow + 1
You paste headings over the top of the last row of child data and then increase the output row number. You need to increment RptRow by 1, then paste, then increment again.
 
Upvote 0
It's odd but now I get all the child records but and extra row is inserted (or the code misses/increments the rows) between the 2nd last and last child row

At least I have all the data and I could create a macro to delete all blank rows
 
Upvote 0
I don't see how with your code. Bit of a long shot, but you don't have any white fonts in use do you?
 
  • Like
Reactions: shg
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question
EXCEL VBA Combo box filter not working with numerical value but does with text value
Replies
0
Views
327
jocotterellash
J
T
  • Question
Macro to fill down for a range of cells
2
Replies
11
Views
494
Fluff
Fluff
B
  • Solved
Find last row of data in cell A that is a part of a table
Replies
9
Views
123
Alex Blakenburg
A
MustacheKaboom
  • Solved
VBA Noob. All but the last step works... GAH!!
Replies
4
Views
347
MustacheKaboom
MustacheKaboom
B
  • Question
Paste results of Filter Function in place, or in separate sheet
Replies
0
Views
129
bertible
B

Forum statistics

Threads
1,215,326
Messages
6,124,272
Members
449,149
Latest member
mwdbActuary

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top