Selecting a range with blank cells

[Vincent paul]

Hi,

I have a range with blank cells like this

[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]Store name[/TD]
[TD]Item 1[/TD]
[TD]Item 2[/TD]
[TD]Item 3[/TD]
[/TR]
[TR]
[TD]Store A[/TD]
[TD]2[/TD]
[TD]3[/TD]
[TD]4[/TD]
[/TR]
[TR]
[TD]Store B[/TD]
[TD]1[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Store C[/TD]
[TD]1[/TD]
[TD][/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]Store D[/TD]
[TD][/TD]
[TD]1[/TD]
[TD]1[/TD]
[/TR]
</tbody>[/TABLE]









If blank cell is in between the range, code is not copying entire range.

Sub conc()
Dim myRow As Long
Dim storename As String
Dim myRange As Range
Dim cellrange As Range

Application.ScreenUpdating = False
Workbooks("E-shopaid Raw Data Jun'15.xlsx").Sheets("Comp").Activate
Range("A5").Select
Set myRange = Workbooks("E-shopaid Raw Data Jun'15.xlsx").Sheets("Comp").Range("A5")
Do Until myRange.Value = "Grand Total"
storename = myRange.Value
Set cellrange = Worksheets(storename).Range("B1")
If storename = cellrange Then
Range(myRange.Offset(0, 1), myRange.End(xlToRight)).Copy
ThisWorkbook.Activate
Worksheets(storename).Select
ActiveCell.PasteSpecial Paste:=xlPasteValues
Workbooks("E-shopaid Raw Data Jun'15.xlsx").Sheets("Comp").Activate
Set myRange = myRange.Offset(1, 0)
Else
MsgBox "Store name mismatch"
ActiveSheet.Next.Select
End If
Loop
End sub

Thanks..

 

[MARK858]

I haven't looked at the rest of the code but try

Sub conc()
    Dim myRow As Long
    Dim storename As String
    Dim MyRange As Range
    Dim cellrange As Range

    Application.ScreenUpdating = False
    Workbooks("E-shopaid Raw Data Jun'15.xlsx").Sheets("Comp").Activate
    Range("A5").Select
    Set MyRange = Workbooks("E-shopaid Raw Data Jun'15.xlsx").Sheets("Comp").Range("A5")
    Do Until MyRange.Value = "Grand Total"
        storename = MyRange.Value
        Set cellrange = Worksheets(storename).Range("B1")
        If storename = cellrange Then
            [COLOR="#000080"]Range(MyRange.Offset(0, 1), Cells(MyRange.Row, Columns.Count).End(xlToLeft)).Copy[/COLOR]
            ThisWorkbook.Activate
            Worksheets(storename).Select
            ActiveCell.PasteSpecial Paste:=xlPasteValues
            Workbooks("E-shopaid Raw Data Jun'15.xlsx").Sheets("Comp").Activate
            Set MyRange = MyRange.Offset(1, 0)
        Else
            MsgBox "Store name mismatch"
            ActiveSheet.Next.Select
        End If
    Loop
End Sub

 

[Vincent paul]

Thanks for the reply Mark. It works fine.. but the issue is i have another set of data in adjacent columns.

Is there any other way to accomplish this..

 

[MARK858]

how do you decide where one range ends and the new one begins?

 

[Vincent paul]

Hi,

Pls check the below link for the data. It would give the idea on the range..

http://i.imgur.com/5hOu2WV.png

 

[MARK858]

3 things...

a) you have posted an image which cannot be copied in a usable form into Excel so if anyone wants to test the code they would have to retype the data. Most posters (myself included) won't do that and will more than likely just skip the thread. Please see my signature block for some ways to post a usable screenshot.

b) the image you posted doesn't even include the column labels so is of no use for trying to work out where one range ends and another starts (and I still want to know how you define it i.e. is the range always the same width (if yes why can't you hard code it as probably the empty cells after the last used cell aren't relevant (like in store B in your original post) as you don't have to resize the area it is being pasted into judging by the rest of the code you posted?)

c) your image looks like it is a pivot table. Is this correct?