Need Help in making minor modification to an excel vba code.

[Nick G]

Hello all,
I found the below vba code on the same forum where one can unmerge and fill down the duplicates values. The problem is that my data has addresses which have pin code at the end and floor no in the beginning, so when it unmerge and autofills it down it increases the numbers like. The 1st floor becomes 2nd floor,3rd floor and like that at the beginning and the pin code increases from 400028 to 400029 etc.

The data is large so I can not do it manually. The below code is otherwise working perfectly the only thing I want is that I don't want the autofill to be incremental.

So is there any way I can make modification to the below code to just fill down anything without increasing the values in autofill. Please help.

Thanks in advance.

Public Sub ProcessData() 
Dim cell As Range 
Dim MergedCell As Range 
Dim NumRows As Long 
Dim NumCols As Long 

With Application 

.ScreenUpdating = False 
.Calculation = xlCalculationManual 
End With 

With ActiveSheet 

For Each cell In Range("A1").Resize( _ 
.Cells.SpecialCells(xlCellTypeLastCell).Row, _ 
.Cells.SpecialCells(xlCellTypeLastCell).Column) 

If cell.MergeCells Then 

NumRows = cell.MergeArea.Rows.Count 
NumCols = cell.MergeArea.Columns.Count 
cell.UnMerge 
If NumRows > 1 Then cell.AutoFill cell.Resize(NumRows) 
If NumCols > 1 Then cell.Resize(NumRows).AutoFill cell.Resize(NumRows, NumCols) 
End If 
Next cell 
End With 

With Application 

.Calculation = xlCalculationAutomatic 
.ScreenUpdating = True 
End With 

End Sub

[大灰狼1976]

Hi Nick G!
Welcome to vbax forum.
Not sure

If NumRows > 1 Then cell.AutoFill Destination:=cell.Resize(NumRows), Type:=xlFillCopy
If NumCols > 1 Then cell.Resize(NumRows).AutoFill Destination:=cell.Resize(NumRows, NumCols), Type:=xlFillCopy

[Nick G]

Thanks for the welcome and for the prompt reply. Oh God bless your soul. It's working like a charm now. I can't thank you enough.

[大灰狼1976]

@Nick. Can you post an attachment for my test?

[Nick G]

Sorry, As it was the file from the work I can't share the exact file. But when I go home today I could try to replicate the same and if it comes out that way, I will share it with you. Thanks again

[大灰狼1976]

I made an example and did not find problem what you said.

Sorry, I didn't see your update, please ignore this reply.


--Okami

[大灰狼1976]

I think it's better to change it to this way.

    If cell.MergeCells Then
      NumRows = cell.MergeArea.Rows.Count
      NumCols = cell.MergeArea.Columns.Count
      cell.UnMerge
      cell.Resize(NumRows, NumCols) = cell
    End If