• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Copy skipping blanks cells and matching cells

aamirsq

aamirsq

Member
Hello Friends,

Hope you are doin' fine. Almost a year ago thanks to Mr. Debraj who helped me in this below vb code which worked perfect.

Code: 
Sub Copy_Stuff1()

Dim cell As Range, rr As Long
rr = 2
Application.ScreenUpdating = False
Sheets("Sheet1").Range("A2:A3000").ClearContents
For Each cell In Sheets("main").Range("B2:O100")
If Len(cell)> 0 Then 
Sheets("Sheet1").Range("A" & rr).Value = cell.Value
rr = rr + 1
End If
Next cell
Application.ScreenUpdating = True
End Sub

This line is giving syntax error message
Code: 
If Len(cell)> 0 Then
& now i want to add extra matching option (for corresponding date and location) in this code as shown in sample file.
Thanks
 

Attachments

When the forums migrated a little more than a year ago, some symbols got screwed up, and changed into "&#__;" where __ is the ASCII code number. To fix your syntax error, change:
Code: 
If Len(cell)> 0 Then
into this:
Code: 
If Len(cell) > 0 Then
 
i copied the data to other sheet, (sheet1) , this contains filtered data from B2:O100, and on sheet2 i copied data from B1:O1. when i was trying to match i am unable to get required result.

Code: 
=INDEX(main!$B$1:$O$1,MATCH(Sheet2!A2,main!$B$1:$O$1,0))
 
Could you post an example of this new layout (sheet1 and sheet2), and an example of what the formula should return?
 
Blow the merged cells away, fill in blank cells.
Code: 
Sub Copy_Stuff1()

Dim cell As Range, rr As Long
rr = 2
Application.ScreenUpdating = False
Sheets("Sheet1").Range("A2:C3000").ClearContents
With Worksheets("main")
  
    'Deal with merged cells
    .Range("A:A").Cells.MergeCells = False
    On Error Resume Next
    .Range("A:A").SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=r[-1]C"
    On Error GoTo 0
    .Range("A:A").Copy
    .Range("A:A").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
  
  
    'By using the special cells, we speed up our task since we don't need to look at every cell
    For Each cell In .Range("C2:P100").SpecialCells(xlCellTypeConstants)
        'Item
        Sheets("Sheet1").Range("A" & rr).Value = cell.Value
        'Date is in row 1, but in cell's column
        Sheets("Sheet1").Range("B" & rr).Value = .Cells(1, cell.Column).Value
        'Region is in column A, but in cell's row
        Sheets("Sheet1").Range("C" & rr).Value = .Cells(cell.Row, "A").Value
        'Location is in column A, but in cell's row
        Sheets("Sheet1").Range("D" & rr).Value = .Cells(cell.Row, "B").Value
        rr = rr + 1
    Next cell
End With
Application.ScreenUpdating = True
End Sub
 
You must log in or register to reply here.
Back
Top