Moving rows upwards ... one at a time

fluffynicesheep

Board Regular
Joined
Oct 27, 2009
Messages
69
Hi,

I currently have some code that looks at data in row 2 of a worksheet. After pressing a button, the VBA pulls the information from the cells in that particular row, through to other cells in the workbook, it then automatically saves this info as a new document and then returns to the first worksheet and moves the data upwards, so that row 3 has now become row 2 etc....

Basically I can't delete row 1 or row 2, as this will mess up all the formulas in the other tabs ... so found this to be the best way of doing it!.

Sure enough the first time I press the button, it does everything I want ... all the info in row 2 goes into the correct cells in other parts of the workbook, it then saves the document, returns to the original page, and the subsequent rows all move up 1 - meaning row 2 disappears and row 3 becomes the new row 2 ... so the new lot of data is now present throughout the rest of the workbook.


However, when I run the VBA for a 2nd time it now runs as normal, it saves the document with the new name, but it now stops on this line ......

VBA Code:
.Range("A2:MN" & LastRow - 1).Value = .Range("A3:MN" & LastRow).Value

So there's some issues with moving up the rows again!!

Not sure why this is any different from the first time I have pressed the button ... so consider myself stumped!!

If anyone has any ideas that would be great.

This is the full code that I have:

VBA Code:
Sub Rectangle3_Click()
Dim wbA As Workbook
Dim wbB As Workbook
Dim strFileName As String
Dim DataSheet As Worksheet
Dim MyRange As Range
Dim LastRow As Long


Set DataSheet = Sheets("AEB - Copy Values")
With DataSheet
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
If LastRow = 2 Then Exit Sub


    Application.ScreenUpdating = False

    Set wbA = ThisWorkbook

    wbA.Sheets("NCS - Copy Values Skip Blanks").Visible = True
    
    wbA.Sheets("NCS - Copy Values Skip Blanks").Copy

    Set wbB = ActiveWorkbook

    With wbB
    
        With .Sheets(1).UsedRange
            .Copy
            .PasteSpecial xlValues
            .PasteSpecial xlFormats
        End With
        
        Dim nm As Name
Dim DeleteCount As Long

'Loop through each name and delete
  For Each nm In ActiveWorkbook.Names
    On Error GoTo Skip
    
    If SkipPrintAreas = True And Right(nm.Name, 10) = "Print_Area" Then GoTo Skip
    
    nm.Delete
    DeleteCount = DeleteCount + 1

Skip:
    
  Next
  
'Reset Error Handler
  On Error GoTo 0
     
'Report Result
  If DeleteCount = 1 Then
    MsgBox "[1] name was removed from this workbook."
  Else
    MsgBox "[" & DeleteCount & "] names were removed from this workbook."
  End If


        Application.CutCopyMode = False

        strFileName = .Sheets(1).Range("FW9").Value

        .SaveAs wbA.Path & Application.PathSeparator & strFileName & ".xlsb", xlExcel12
        .Close SaveChanges:=False
    End With
    wbA.Sheets("NCS - Copy Values Skip Blanks").Visible = False
    Sheets("AEB - Copy Values").Select
ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1
Cells(1, 1).Activate
ActiveCell.Next.Select
Application.ScreenUpdating = True


Application.ScreenUpdating = False
.Range("A2:MN" & LastRow - 1).Value = .Range("A3:MN" & LastRow).Value
.Range("A" & LastRow & ":MN" & LastRow).ClearContents
Application.ScreenUpdating = True
End With
End Sub
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
However, when I run the VBA for a 2nd time it now runs as normal, it saves the document with the new name, but it now stops on this line ......
VBA Code:
.Range("A2:MN" & LastRow - 1).Value = .Range("A3:MN" & LastRow).Value

What does the error message say?

I did tests with sample data and I have no problems.
Maybe something with your data. You have merged cells. Is the sheet protected?
 
Upvote 0
Hi,

No it' not protected at all.

The error message I get is:

Run Time error 6 - overflow

Then when I click ok ... it highlights this line of code:

VBA Code:
.Range("A2:MN" & LastRow - 1).Value = .Range("A3:MN" & LastRow).Value
 
Upvote 0
Hi Dante,

I'm going to be looking at a maximum of around 40 rows that will need to be moved up one at a time ... so that particular button may have to be pressed around 38 times, until it works it's way to the top (or row 2).

Once it gets to row 2, I then click another button to import a different set of 40 (or similar rows) - again this starts on row 2, and could go back down to row 40 or similar ..... the looping process would then start again for this lot of information.

So there definitely isn't a lot of data, so not sure why there is an overflow!
 
Upvote 0
Try the following.
What it does is pass row 3 to row 2, then pass row 4 to row 2 and so on until it reaches the last row with data.
With this macro it is not necessary to execute it 40 times, the macro will automatically execute the executions of the 40 rows.

VBA Code:
Sub Rectangle3_Click()
  Dim wbA As Workbook, wbB As Workbook, DataSheet As Worksheet, nm As Name
  Dim strFileName As String, i As Long, SkipPrintAreas
  
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  Set wbA = ThisWorkbook
  Set DataSheet = wbA.Sheets("AEB - Copy Values")
  
  wbA.Sheets("NCS - Copy Values Skip Blanks").Visible = True
  For i = 3 To DataSheet.Cells(DataSheet.Rows.Count, 1).End(xlUp).Row
    DataSheet.Range("A2:MN2").Value = DataSheet.Range("A" & i & ":MN" & i).Value
    wbA.Sheets("NCS - Copy Values Skip Blanks").Copy
    Set wbB = ActiveWorkbook
    With wbB.Sheets(1).UsedRange
      .Copy
      .PasteSpecial xlValues
      .PasteSpecial xlFormats
      Application.CutCopyMode = False
    End With
    
    On Error Resume Next  'Loop through each name and delete
    For Each nm In wbB.Names
      If Not (SkipPrintAreas = True And Right(nm.Name, 10) = "Print_Area") Then nm.Delete
    Next
    On Error GoTo 0 'Reset Error Handler
    
    strFileName = wbB.Sheets(1).Range("FW9").Value
    wbB.SaveAs wbA.Path & Application.PathSeparator & strFileName & ".xlsb", xlExcel12
    wbB.Close SaveChanges:=False
  Next
End Sub
 
Upvote 0
Hi Dante,

Looking good... I've tried it with 6 rows and just a couple of issues:

1) I have data in row 2,3,4,5 and 6...... once I click the button the macro you have sent me produces the required save document for the information contained in rows 3,4,5 and 6 - so is just missing the save for the data that was in row 2 (originally)
2) Once the macro ends, it still shows lines 2,3,4,5,6, etc ..... please can you add a line to the end that deletes rows 3 onwards .. so just leaves row 2.

Apart from that, I think it works really well!
 
Upvote 0
Try this

Rich (BB code):
Sub Rectangle3_Click()
  Dim wbA As Workbook, wbB As Workbook, DataSheet As Worksheet, nm As Name
  Dim strFileName As String, i As Long, SkipPrintAreas
  
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  Set wbA = ThisWorkbook
  Set DataSheet = wbA.Sheets("AEB - Copy Values")
  
  wbA.Sheets("NCS - Copy Values Skip Blanks").Visible = True
  For i = 2 To DataSheet.Cells(DataSheet.Rows.Count, 1).End(xlUp).Row
    DataSheet.Range("A2:MN2").Value = DataSheet.Range("A" & i & ":MN" & i).Value
    wbA.Sheets("NCS - Copy Values Skip Blanks").Copy
    Set wbB = ActiveWorkbook
    With wbB.Sheets(1).UsedRange
      .Copy
      .PasteSpecial xlValues
      .PasteSpecial xlFormats
      Application.CutCopyMode = False
    End With
    
    On Error Resume Next  'Loop through each name and delete
    For Each nm In wbB.Names
      If Not (SkipPrintAreas = True And Right(nm.Name, 10) = "Print_Area") Then nm.Delete
    Next
    On Error GoTo 0 'Reset Error Handler
    
    strFileName = wbB.Sheets(1).Range("FW9").Value
    wbB.SaveAs wbA.Path & Application.PathSeparator & strFileName & ".xlsb", xlExcel12
    wbB.Close SaveChanges:=False
  Next
  DataSheet.Rows("3:" & rows.count).clearcontents
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,893
Messages
6,175,240
Members
452,621
Latest member
Laura_PinksBTHFT

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