Insert rows from a master sheet, in between 2 named ranges using VBA

[Youngdand]

Hi,

I currently have a template in which i have a lot of pre prepared formula, which extract information from data in order to produce, invoices statements and remittance advice notes. All formula are written to use defined names, I have a range in which i currently insert data manually, and the formula works out the column totals by looking at anything in the cell header + 1 and total -1, meaning the range can grow and shrink dynamically. excat formula:

eg =ROUND(SUM(INDIRECT(ADDRESS(ROW(APHeader)+1,COLUMN(APHeader))):INDIRECT(ADDRESS(ROW(APtotal)-1,COLUMN(APtotal)))),2)

The sheet uses a Validation list, which pulls in all the data related to a particular client using lookups, that are required for the various output sheets, ie invoice, etc.

I am looking for a way, if possible to return all the data rows related to the client chosen, from the master list, and insert them in to the data sheet between the points apheader and aptotal without overwriting any of the items below aptotal. however the number of lines can vary depending on client.

Alternatively, a VBA script that can be linked to a button which looks up the value of named range client in the data sheet, and select the data from the master sheet with the corresponding client name, and copy the entire rows, relating to that client, and insert them in to the data sheet between position apheader and aptotal. some of these client may return numbers of rows in excess of 4K.

My VBA knowledge is basic, but i can normally follow through the logic.

Any tips or help would be greatly appreciated.


Thanks Dan.

 

[Youngdand]

Bump,

Can anyone help with this one?

Thanks,

Dan.

 

[tonyyy]

Dan,

You might consider the following...

Sub CopyData_1024872()
Application.ScreenUpdating = False
Dim ws1 As Worksheet, ws2 As Worksheet
Dim APheader As Long, APtotal As Long, kount As Long
Dim rngName As String, rng As Range

Set ws1 = Sheets("master list")
Set ws2 = Sheets("data sheet")
APheader = ws2.Cells.Find(What:="APheader", After:=ws2.Cells(1, 1), LookIn:=xlFormulas, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
APtotal = ws2.Cells.Find(What:="APtotal", After:=ws2.Cells(1, 1), LookIn:=xlFormulas, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
rngName = ws2.Range("A1").Value
kount = ws1.Range(rngName).Rows.Count

If APtotal - APheader > 1 Then ws2.Range(ws2.Rows(APheader + 1), ws2.Rows(APtotal - 1)).EntireRow.Delete
ws1.Range(rngName).EntireRow.Copy
Rows(APheader).Offset(1, 0).Resize(kount, 1).EntireRow.Insert
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Assumptions / Notes
There are two worksheets - "master list" and "data sheet".
The data validation (drop down) list is on the "data sheet" in cell A1, and contains the names of the named ranges in the "master list".
The macro will first delete the existing data between APheader and APtotal before populating the new data.

Cheers,

tonyyy

 

[Youngdand]

Assumptions / Notes
There are two worksheets - "master list" and "data sheet".
The data validation (drop down) list is on the "data sheet" in cell A1, and contains the names of the named ranges in the "master list".
The macro will first delete the existing data between APheader and APtotal before populating the new data.

Cheers,

tonyyy

Hi Tony,

Thanks for the above, and it looks almost exactly what i need. However, and i think that this maybe down to me not being clear in my OP, the master list, does not contain any named ranges, and will change regularly, it also contains on average, 35000 rows split over 96 client references. So naming the ranges would slow things down considerably. Is there either A, a way of automatically creating the ranges as part of the script based on the contents of a cell, or b, using the conents of a cell to decide which rows to bring back?

I will sit down an have a play with it myself a little later to see if i can come up with a solution.


Thanks a million.

Regards,

Dan.

 

[Youngdand]

Sub CopyData_1024872()
Application.ScreenUpdating = False
Dim ws1 As Worksheet, ws2 As Worksheet
Dim APheader As Long, APtotal As Long, kount As Long
Dim rngName As String, rng As Range

Set ws1 = Sheets("master list")
Set ws2 = Sheets("data sheet")
APheader = ws2.Cells.Find(What:="APheader", After:=ws2.Cells(1, 1), LookIn:=xlFormulas, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
APtotal = ws2.Cells.Find(What:="APtotal", After:=ws2.Cells(1, 1), LookIn:=xlFormulas, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
rngName = ws2.Range("A1").Value
kount = ws1.Range(rngName).Rows.Count

If APtotal - APheader > 1 Then ws2.Range(ws2.Rows(APheader + 1), ws2.Rows(APtotal - 1)).EntireRow.Delete
ws1.Range(rngName).EntireRow.Copy
Rows(APheader).Offset(1, 0).Resize(kount, 1).EntireRow.Insert
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Hi Tony,

I am getting run time error 91 in relationg to this bit of the code:

Sub CopyData_1024872()
Application.ScreenUpdating = False

APheader = ws2.Cells.Find(What:="APheader", After:=ws2.Cells(1, 1), LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
and if i comment out the above the follwoing section then fails for the same reason.

APtotal = ws2.Cells.Find(What:="APtotal", After:=ws2.Cells(1, 1), LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row

Any idea what may be wrong here?

 

[Youngdand]

OK So, a couple of mistakes on my part! never pasted in the master list data!

i have hacked the code a little and it appears to be working ok below is the alter code

Sub CopyData_1024872()
On Error GoTo HERE
Application.ScreenUpdating = False
Dim ws1 As Worksheet, ws2 As Worksheet
Dim APheader As Long, APtotal As Long, kount As Long
Dim rngName As String

Set ws1 = Sheets("master list")
Set ws2 = Sheets("data sheet")
rngName = Range("client").Value
APheader = Range("APheader").Row
APtotal = Range("aptotal").Row

rngName = ws2.Range("A6").Value

kount = 0
kount = Range(rngName).Rows.Count


If APtotal - APheader > 1 Then ws2.Range(ws2.Rows(APheader + 1), ws2.Rows(APtotal - 1)).EntireRow.Delete
ws1.Range(rngName).EntireRow.Copy
Rows(APheader).Offset(1, 0).Resize(kount, 1).EntireRow.Insert
Application.CutCopyMode = False
Application.ScreenUpdating = True

Exit Sub

HERE:
    If APtotal - APheader > 1 Then ws2.Range(ws2.Rows(APheader + 1), ws2.Rows(APtotal - 1)).EntireRow.Delete
    MsgBox ("No Data " & rngName)

End Sub

I still need to either:
A, find a way of automatically creating the ranges as part of the script based on the contents of a cell, or
B, using the conents of a cell to decide which rows to bring back?

Also i only want to bring back columns D:K from the master list sheet and insert these.

ONce again, any help would be muchly appreciated. Also if there are any flaws in my code above, please feel free to let me know.

Thanks,

Dan.

 

[tonyyy]

Can you post some sample data from the master list? Which column contains the client names or identifiers? Is the data sorted? ie, Are the clients' data contiguous?

 

[Youngdand]

Can you post some sample data from the master list? Which column contains the client names or identifiers? Is the data sorted? ie, Are the clients' data contiguous?

Link to example file

https://drpl365-my.sharepoint.com/personal/daniel_drpl_co_uk/_layouts/15/guestaccess.aspx?docid=1d695f9112047497bbcb20a129414385e&authkey=AbXiDymK0ck-kXbPGKT9Wpw

Client is in Cell B,

An Ideally the range i wish to bring though is D$ - K$ for each change in client. the change in client can be controled via the data validation, using the range "client" in the data sheet.

Again i will be playing with this today, so if i stumble across a solution i will post back so no one is wasting their time.

Thanks,

Dan.

 

[Youngdand]

Just for reference this is the lastest version of the code.

Added, error handling, and in the on error section to insert a row after deleting the previous data rows , this needs to be in otherwise it causes circular references within the data sheet, causing the sheet to fail to recaluclate and leaving the formula with the balance of the previous companies. As it possible for there to be no data in this section, but further items being pulled from other places, this would have potentially caused issues.

Sub Get_Data()
On Error GoTo HERE
Application.ScreenUpdating = False
Dim ws1 As Worksheet, ws2 As Worksheet
Dim APheader As Long, APtotal As Long, kount As Long
Dim rngName As String

Set ws1 = Sheets("master list")
Set ws2 = Sheets("data")
rngName = Range("client").Value
APheader = Range("APheader").Row
APtotal = Range("aptotal").Row

rngName = ws2.Range("client").Value

kount = 0
kount = Range(rngName).Rows.Count


If APtotal - APheader > 1 Then ws2.Range(ws2.Rows(APheader + 1), ws2.Rows(APtotal - 1)).EntireRow.Delete
ws1.Range(rngName).EntireRow.Copy
Rows(APheader).Offset(1, 0).Resize(kount, 1).EntireRow.Insert
Application.CutCopyMode = False
Application.ScreenUpdating = True

Exit Sub

HERE:
    If APtotal - APheader > 1 Then ws2.Range(ws2.Rows(APheader + 1), ws2.Rows(APtotal - 1)).EntireRow.Delete
    ws2.Range("blank").EntireRow.Copy
    Rows(APheader).Offset(1, 0).Resize(kount + 1, 1).EntireRow.Insert
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
End Sub

 

[tonyyy]

Thanks, Dan, for posting the sample data. In future, would appreciate actual data rather than a pic. Please see my signature on how to post Excel data.

Modifying your latest version of code...

Sub Get_Data()
Application.ScreenUpdating = False
Dim ws1 As Worksheet, ws2 As Worksheet
Dim APheader As Long, APtotal As Long, kount As Long
Dim rngName As Range, r As Range

Set ws1 = Sheets("master list")
Set ws2 = Sheets("data")
Set rngName = Range("client")
APheader = Range("APheader").Row
APtotal = Range("aptotal").Row

''''Delete existing data from data sheet
If APtotal - APheader > 1 Then ws2.Range(ws2.Rows(APheader + 1), ws2.Rows(APtotal - 1)).EntireRow.Delete

''''Filter master list using client as criteria; determine number of data rows
If ws1.AutoFilterMode = True Then ws1.AutoFilterMode = False
With ws1.UsedRange
    .AutoFilter
    .AutoFilter Field:=2, Criteria1:=rngName
    For Each r In .Resize(, 1).SpecialCells(xlCellTypeVisible)
        kount = kount + 1
    Next r
End With
kount = kount - 1 'Subtract 1 for header row

''''Insert number of data rows into data sheet; copy data from master list to data sheet
If kount > 0 Then
    Rows(APheader).Offset(1, 0).Resize(kount, 1).EntireRow.Insert
    ws1.Range(ws1.Cells(2, 4), ws1.Cells(ws1.UsedRange.Rows.Count, 11)).SpecialCells(xlCellTypeVisible).Copy _
        Destination:=ws2.Cells(APheader + 1, 1)
Else
    Rows(APheader).Offset(1, 0).Resize(1, 1).EntireRow.Insert 'If no data rows then insert blank row
End If

''''Finish
ws1.AutoFilterMode = False
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub