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

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
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 Question
EXCEL VBA Combo box filter not working with numerical value but does with text value
Replies
0
Views
449
jocotterellash
J
S
  • Question Question
Vba to search for a value in column A, if found enter specific text then delete the row
Replies
2
Views
217
StevenChin
S
M
  • Solved
Insert new row with incremental formula
Replies
8
Views
479
Sheik
S
M
  • Solved
VBA Help - Duplicate & Unwanted Data Removal
Replies
6
Views
880
MoonDancer
M
T
  • Question Question
Macro to fill down for a range of cells
2
Replies
11
Views
2K
Fluff
Fluff

Forum statistics

Threads
1,223,247
Messages
6,171,007
Members
452,374
Latest member
keccles

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