Copy skipping blanks cells and matching cells

[aamirsq]

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.

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

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

 

[Luke M]

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:

If Len(cell)> 0 Then

into this:

If Len(cell) > 0 Then

 

[aamirsq]

First part solved.

& now i want to add extra matching option (for corresponding date and location) in this code as shown in sample file.
Thanks

 

[aamirsq]

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.

=INDEX(main!$B$1:$O$1,MATCH(Sheet2!A2,main!$B$1:$O$1,0))

 

[Luke M]

Could you post an example of this new layout (sheet1 and sheet2), and an example of what the formula should return?

 

[aamirsq]

Sample file uploaded

 

[Luke M]

Since we're already running a macro, we can have it do the work.

 

[aamirsq]

What if i have a column (merged cells) in beginning of Regions. how to allocate with merged cells?

 

[Luke M]

Blow the merged cells away, fill in blank cells.

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

 

[aamirsq]

thanks