Stuck in loop Tyring to paste multiple named ranges to a different sheet.

[pacman_d]

Hi Guys,

I'm pasting values from one sheet to another based on multiple named ranges. Woks great when pasting one column but when i add multiple ranges, UFFF!...
Read below...

General Overview:

I have a sample workbook attached, there are (2) sheets of importance.

First is the sheet (EstSummary) where I have miraculously been able to hack together coding a button control to import data from the (Svc) sheet.

The second Sheet (Svc) is a table of estimating service data that i have put together to input and price services.

I have created a number of named ranges (SvcDesc, SvcHdr, SvcQty, SvcSid, etc..)..
All the ranges above are single columns in the the Svc table and are dynamic leveraging the OFFSET function.

First issue: (Code in the import button.)

When I run this code to copy a single named range to the EstSummary Sheet, i have no issues pasting and re-pasting as the code checks for text and offsets one row past the next available cell row in that column.

When I augment the code to reference multiple named ranges, the first paste works great. But then if i hit the button again, it freezes in the loop and i have to force the app to close. I will be duplicating this button to pull from additional sheets like the (Svc) sheet so I am looking to fix the loop. I am JUST learning VB so I'm still very basic with my understanding.
=========================================================

[FONT=Arial]Private Sub ProServices_Click()[/FONT]
 
[FONT=Arial]Dim RngToCopySID As Range[/FONT]
[FONT=Arial]Dim RngToCopyHdr As Range[/FONT]
[FONT=Arial]Dim RngToCopyQty As Range[/FONT]
[FONT=Arial]Dim RngToCopyDesc As Range[/FONT]
 
[FONT=Arial]Dim DestCellSid As Range[/FONT]
[FONT=Arial]Dim DestCellHdr As Range[/FONT]
[FONT=Arial]Dim DestCellQty As Range[/FONT]
[FONT=Arial]Dim DestCellDesc As Range[/FONT]
 
[FONT=Arial]With Worksheets("Svc")[/FONT]
[FONT=Arial]Set RngToCopySID = .Range("SvcSid")[/FONT]
[FONT=Arial]Set RngToCopyHdr = .Range("Svchdr")[/FONT]
[FONT=Arial]Set RngToCopyQty = .Range("SvcQty")[/FONT]
[FONT=Arial]Set RngToCopyDesc = .Range("SvcDesc")[/FONT]
 
[FONT=Arial]End With[/FONT]
 
[FONT=Arial]With Worksheets("EstSummary")[/FONT]
[FONT=Arial]Set DestCellSid = .Range("A21")[/FONT]
[FONT=Arial]Set DestCellHdr = .Range("B21")[/FONT]
[FONT=Arial]Set DestCellQty = .Range("C21")[/FONT]
[FONT=Arial]Set DestCellDesc = .Range("D21")[/FONT]
[FONT=Arial]End With[/FONT]
 
[FONT=Arial]Do[/FONT]
[FONT=Arial]If IsEmpty(DestCellSid.Value) Then[/FONT]
[FONT=Arial]If IsEmpty(DestCellHdr.Value) Then[/FONT]
[FONT=Arial]If IsEmpty(DestCellQty.Value) Then[/FONT]
[FONT=Arial]If IsEmpty(DestCellDesc.Value) Then[/FONT]
 
[FONT=Arial]Exit Do[/FONT]
 
[FONT=Arial]Else[/FONT]
[FONT=Arial]Set DestCellSid = DestCellDesc.Offset(2, 0)[/FONT]
[FONT=Arial]Set DestCellHdr = DestCellDesc.Offset(2, 0)[/FONT]
[FONT=Arial]Set DestCellQty = DestCellQty.Offset(2, 0)[/FONT]
[FONT=Arial]Set DestCellDesc = DestCellQty.Offset(2, 0)[/FONT]
 
[FONT=Arial]End If[/FONT]
[FONT=Arial]End If[/FONT]
[FONT=Arial]End If[/FONT]
[FONT=Arial]End If[/FONT]
 
[FONT=Arial]' This is where it gets stuck!!!! See below![/FONT]
 
[FONT=Arial]Loop [/FONT]
 
[FONT=Arial]RngToCopySID.Copy[/FONT]
[FONT=Arial]DestCellSid.PasteSpecial Paste:=xlPasteValues[/FONT]
 
[FONT=Arial]RngToCopyHdr.Copy[/FONT]
[FONT=Arial]DestCellHdr.PasteSpecial Paste:=xlPasteValues[/FONT]
 
[FONT=Arial]RngToCopyQty.Copy[/FONT]
[FONT=Arial]DestCellQty.PasteSpecial Paste:=xlPasteValues[/FONT]
 
[FONT=Arial]RngToCopyDesc.Copy[/FONT]
[FONT=Arial]DestCellDesc.PasteSpecial Paste:=xlPasteValues[/FONT]
 
[FONT=Arial]End Sub[/FONT]

==========================================================

Second issue: (Blanks in the named range)

In My SvcHdr named range there are sometimes blanks. I use this column in my data to help with conditional formatting of on the source and destination sheets. So someone who is preparing a quote can say "Well this row will serve as a header for the following rows." So this selection would be variable. I surmise that this issue exists for other named ranges as well as they may all not be populated with data all the way down the column.

The range should extend from C13:C55.. I use the header information for conditional formatting on both pages (H1 for example). So I may have it on C13 and again on C20, then C30.

The problem is that when there are blanks in between the rows the dynamic range extends only to the second occurance of the H1 value.

For instance, if I look at the range as it is set up above, it will show me that the range spans C13:C20.. It will not go past C20 to also cover C30 and down the rest of the column down to C55...

I guess i could work around this by setting a sheet macro that will look at that range and fill that column with "-" or something so that there is a value in the field. I tried to but i couldn't get it to work.

Stupid question, Is it possible to call the Full table named range (SvcFull) and just pull the data from the column in that range and paste it to the right columns in the destination sheet (EstSummary)?

It would be so much cleaner if i could just work with one named range for a set of page data and just call the columns i need rather than having to break out each column into different named range single columned data sets.

Any help would be appreciated.

Thanks,

P

 

[pacman_d]

Hey guys,

Have I done something off with my post?

Any takers?

I'm a little jammed up with this.

Thanks,

P

 

[baitmaster]

issue 1 - you don't seem to have an escape from your loop

If I understand this right - and there's a good chance I don't because I can't test it at the moment - then you are writing something into e.g. DestCellSid. Once you've done this, when you ask ISEMPTY(), and get the answer FALSE, you won't get an exit DO

I haven't looked at issue 2 yet...

 

[baitmaster]

<quote>
Is it possible to call the Full table named range (SvcFull) and just pull the data from the column in that range and paste it to the right columns in the destination sheet (EstSummary)?

It would be so much cleaner if i could just work with one named range for a set of page data and just call the columns i need rather than having to break out each column into different named range single columned data sets.</quote>

Yes I think so

In the same way that you can refer to e.g. sheets("sheet1").cells(i,j), the .cells(i,j) bit can also be linked to a range - so you could say
with sheets("sheet1").range("myrange")
.range(.cells(1,1),.cells(2,2))
end with

this would refer to the first 2x2 square of cells in your named range

 

[pacman_d]

issue 1 - you don't seem to have an escape from your loop

Thanks!

Since my VB skills are SUPER remedial i am having a difficult time figuring out how to end the loop.

Would it be similar to this:

Do
    If IsEmpty(DestCellSid.Value) Then
Exit Do
Else

Do
    If IsEmpty(DestCellHdr.Value) Then
Exit Do
Else

Do
    If IsEmpty(DestCellQty.Value) Then
Exit Do
Else

    If IsEmpty(DestCellDesc.Value) Then

Exit Do

Else
    Set DestCellSid = DestCellSid.Offset(2, 0)
    Set DestCellHdr = DestCellHdr.Offset(2, 0)
    Set DestCellQty = DestCellQty.Offset(2, 0)
    Set DestCellDesc = DestCellDesc.Offset(2, 0)

End If
End If
End If
End If
Loop

I am looking at your second analysis now. Will report back..

Thanks again!

Best,

P

 

[pacman_d]

Ok so I figured out the loop.

got that working thanks.. (Don't really know HOW i did it but im happy)

Heres the working code to post multiple range columns to a single column without overwriting the previous text.

Private Sub ButtonMaintenance_Click()

Dim RngToCopySID As Range
Dim RngToCopyHdr As Range
Dim RngToCopyQty As Range
Dim RngToCopyDesc As Range

Dim DestCellSid As Range
Dim DestCellHdr As Range
Dim DestCellQty As Range
Dim DestCellDesc As Range

    With Worksheets("Maintenance")
    Set RngToCopySID = .Range("MaiSid")
    Set RngToCopyHdr = .Range("MaiHdr")
    Set RngToCopyQty = .Range("MaiQty")
    Set RngToCopyDesc = .Range("MaiDesc")
    
End With

With Worksheets("EstSummary")
    Set DestCellSid = .Range("A26")
    Set DestCellHdr = .Range("B26")
    Set DestCellQty = .Range("C26")
    Set DestCellDesc = .Range("D26")
End With

Do
    If IsEmpty(DestCellSid.Value) Then
Exit Do
Else
Set DestCellSid = DestCellSid.Offset(2, 0)
End If
Loop

Do
    If IsEmpty(DestCellHdr.Value) Then
Exit Do
Else
Set DestCellHdr = DestCellHdr.Offset(2, 0)
End If
Loop

Do
    If IsEmpty(DestCellQty.Value) Then
Exit Do
Else
Set DestCellQty = DestCellQty.Offset(2, 0)
End If
Loop

Do
    If IsEmpty(DestCellDesc.Value) Then
Exit Do
Else
Set DestCellDesc = DestCellDesc.Offset(2, 0)
End If
Loop

RngToCopySID.Copy
DestCellSid.PasteSpecial Paste:=xlPasteValues

RngToCopyHdr.Copy
DestCellHdr.PasteSpecial Paste:=xlPasteValues

RngToCopyQty.Copy
DestCellQty.PasteSpecial Paste:=xlPasteValues

RngToCopyDesc.Copy
DestCellDesc.PasteSpecial Paste:=xlPasteValues

End Sub

Thanks..

 

[pacman_d]

Ok so on to my next challenge. I have some code set to execute on a worksheet change. There are two bits of code:

The first batch sets the value of a deleted cell to 0..

This helps me keep the integrity of my dynamic ranges as it seems that when they have blanks sporadically distributed, it omits actual data in the columns lower range.

I am looking to target specific named range columns and have this execute only for those columns. Right now it does the whole sheet which creates a problem with the other piece of code for the first column. I will get to that next..

Private Sub Worksheet_Change(ByVal Target As Range)

      Dim r As Range
      Dim ans As String
      Dim cell As Object
      Dim RngQty As Range
      Dim RngSvc As Range
      Const Cola As Long = 1
      Const Colc As Long = 3
      Const Colb As Long = 2
      
      Application.ScreenUpdating = False
          
      For Each cell In Range.Areas.Count
            
        If cell.Value = "" Then
           cell.Value = "0"
      Else: End If
      Next cell

Application.ScreenUpdating = True

The second piece of code is validation for the first column where users enter some data. It looks at the column and makes certain that the user does not enter DUPES...

If Intersect(Target, Columns(Cola)) Is Nothing Then Exit Sub
    
 Application.EnableEvents = False
        
        For Each r In Intersect(Target, Columns(Cola))
        If Application.CountIf(Columns(Cola), r.Value) > 1 Then
        MsgBox (r.Value & " already exsists")
        r.ClearContents

End If

Next

Application.EnableEvents = True

They both work fine except that i don't want that first column's values to be set to 0 when a field is deleted.

If someone were to delete 2 items from that first column, then the whole thing goes haywire as the first batch of code tries to set both vales to zero and the anti dupe code HATES with a LOOPING ferver the fact that there are two zeros in the column that its watching.

So my mission is to accomplish two things:

1. Restrict the CELL=0 code to specific columns using the named range
2. Restrict the Anti Duping code to a single named range. (As it now goes all the way up and down column A..

Thanks again!

Best,

P