VBA for formatting cells to be same as other cells

[JIMMY024]

Hi
looking for some help with formatting cells.

I currently have a spreadsheet that automatically populates depending on a value that is in a certain cell (target address).
The information (target range) is pulled from another sheet ( Sheet 25) and then dropped into the named area I need ("B13:B105")
What I would like is when data comes across into the destination cells ( ("B13:B105") it is in the same font and format as the original i.e. that format in sheet 25 Range.
Currently the info on sheet 25 has all sorts of bold and highlighting which is not being carried across.
also if it could auto size the cells ("B13:B105") to fit the data from the range , and delete any empty rows that would be a bonus..

Here is the code I have so far. any help would be appreciated.

Sub Worksheet_Change(ByVal Target As Range)
' Predetermined values are populated in cells B13:B105 based on type of Agreement.
Application.ScreenUpdating = False

If Target.Address = "$G$11" Then
If Target = "Construction" Then
Range("B13:B105") = Sheet25.Range("A56:A148").Value
ElseIf Target = "Works" Then
Range("B13:B105") = Sheet25.Range("B56:B148").Value
ElseIf Target = "Minor Works" Then
Range("B13:B105") = Sheet25.Range("C56:C148").Value

End If
End If

Application.ScreenUpdating = False

End Sub

Any help would be appreciated.
Thanks
Jim

 

[My Aswer Is This]

Try this:

Sub Worksheet_Change(ByVal Target As Range)
 ' Predetermined values are populated in cells B13:B105 based on type of Agreement.
 Application.ScreenUpdating = False

 If Target.Address = "$G$11" Then
 If Target = "Construction" Then Sheet25.Range("A56:A148").Copy Destination:=Range("B13:B105")
 If Target = "Works" Then Sheet25.Range("B56:B148").Copy Destination:=Range("B13:B105")
 If Target = "Minor Works" Then Sheet25.Range("C56:C148").Copy Destination:=Range("B13:B105")
 End If
 Columns(2).AutoFit
 Application.ScreenUpdating = False
 End Sub

 

[pgc01]

Hi

Remark:

The second ScreenUpdating should be True?

 

[My Aswer Is This]

Your correct I missed that. Thanks

Hi

Remark:

The second ScreenUpdating should be True?

 

[My Aswer Is This]

We need to use this script. I made one small change:

Sub Worksheet_Change(ByVal Target As Range)
 ' Predetermined values are populated in cells B13:B105 based on type of Agreement.
 Application.ScreenUpdating = False

 If Target.Address = "$G$11" Then
 If Target = "Construction" Then Sheet25.Range("A56:A148").Copy Destination:=Range("B13:B105")
 If Target = "Works" Then Sheet25.Range("B56:B148").Copy Destination:=Range("B13:B105")
 If Target = "Minor Works" Then Sheet25.Range("C56:C148").Copy Destination:=Range("B13:B105")
 End If
 Columns(2).AutoFit
 Application.ScreenUpdating = True
 End Sub

 

[My Aswer Is This]

I'm sorry but I think we should use this script:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("G11")) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
' Predetermined values are populated in cells B13:B105 based on type of Agreement.
 Application.ScreenUpdating = False

 If Target.Address = "$G$11" Then
 If Target = "Construction" Then Sheet25.Range("A56:A148").Copy Destination:=Range("B13:B105")
 If Target = "Works" Then Sheet25.Range("B56:B148").Copy Destination:=Range("B13:B105")
 If Target = "Minor Works" Then Sheet25.Range("C56:C148").Copy Destination:=Range("B13:B105")
 End If
 Columns(2).AutoFit
 Application.ScreenUpdating = True
 End Sub

 

[JIMMY024]

Hi
Thank you .. that's fantastic. its working well on the first tab i have tried it on. It will make things a lot quicker.

Do you know of anything that would delete blank rows.
So some of the Range data ("A56:A148") could be blank sometimes and as such will return blank rows to ("B13:B105")
is there anything i can do there that will search for blank rows within ("B13:B105") and delete them?

If not no drama as your answer to above is the biggest fix for me.
Thanks

 

[My Aswer Is This]

I attempted to delete the blank cells but could not figure out how to do that. Maybe someone else here at Mr. Excel will have a answer for that. Glad to see the other part worked for you.

I will continue to monitor this thread to see if someone else have a answer

 

[JIMMY024]

Thanks

Would I be right in saying this does not work when cells are merged?
e.g. if the cells in B13:B105 were merged with Column C for example.?

If that is the case is there something that could be done for those instances?

 

[My Aswer Is This]

Jimmy:
Merged cells can cause you all sorts of problems when using Vba to manipulate data.
Maybe someone else here at Mr. Excel can answer this question.
I would have never attempted to answer if I had known we were working with merged cells.
Next time you have questions and merged cells are involved you need to point that out in your question.
If you follow this Forum often you will see most experts discourage using merged cells.