Macro Problem

[TooZippy]

Hi,

I am trying to combine three macro's into one. When I ran the first part by itself in its own macro it would only insert the formulas into the first two rows. Each part of the macro works by itself but not when I combine them into one macro. When I tried to run the macro as you see it I had to shut down Excel and restart. When I first put this together from different parts I found on the internet, it worked. Now I have this problem. Can anybody help please?

Thank you,

Jared Z.

Sub Merge_Colums()

Columns("F:G").Insert
Range("F2:F" & Range("E2").End(xlDown).Row).Formula = "=IF(LEFT(E2,1)=""-"",MID(E2,2,LEN(E2)),E2)"
Range("G2:G" & Range("F2").End(xlDown).Row).Formula = "=IF(AND(F2>0,S2>0),F2,IF(AND(F2>0,S2=0),F2,IF(AND(F2=0,S2>0),IF(R2>0,CONCATENATE(R2,""-"",S2),S2),0)))"

Columns("F:F").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Application.ScreenUpdating = False
    Dim cell As Range
    ActiveSheet.Cells.Replace What:=Chr(160), Replacement:=Chr(32), _
        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
    On Error Resume Next   'in case no text cells in selection
    For Each cell In ActiveSheet.Cells.SpecialCells(xlConstants, xlTextValues)
        cell.Value = Application.Trim(cell.Value)
    Next cell
    On Error GoTo 0
    Application.ScreenUpdating = True
    
End Sub

 

[JLGWhiz]

I made a coupe of tweaks, see it will run for you now.

Sub Merge_Colums()
Columns("F:G").Insert
Range("F2:F" & Range("E2").End(xlDown).Row).Formula = "=IF(LEFT(E2,1)=""-"",MID(E2,2,LEN(E2)),E2)"
Range("G2:G" & Range("F2").End(xlDown).Row).Formula = "=IF(AND(F2>0,S2>0),F2,IF(AND(F2>0,S2=0),F2,IF(AND(F2=0,S2>0),IF(R2>0,CONCATENATE(R2,""-"",S2),S2),0)))"
Columns("F:F").Copy
Columns("F:F").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.ScreenUpdating = False
    Dim cell As Range
    ActiveSheet.UsedRange.Replace What:=Chr(160), Replacement:=Chr(32), _
        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
    On Error Resume Next   'in case no text cells in selection
    For Each cell In ActiveSheet.UsedRange.SpecialCells(xlConstants, xlTextValues)
        cell.Value = Application.Trim(cell.Value)
    Next cell
    On Error GoTo 0
    Application.ScreenUpdating = True
End Sub

 

[TooZippy]

Ran it and it froze excel. Had to shut it down and restart.

JZ

 

[TooZippy]

Excel unfroze with no formulas in columns F & G with Column F highlighted as if copied.

JZ

 

[JLGWhiz]

I cannot duplicate the freeze in test set up. The code runs as expected on the data I used for testing. To offer anything else I would need to see the worksheet of get a better description of what you acturally have in the cells where the code is executing. See the orange Attachments in post #2 at the bottom or below in this post and click it to find ways of attaching items in the thread.

 

[TooZippy]

Thank you JLG,

I got it to work after I went on the internet and found a code for inserting formulas with a macro. I re-did my code with what I found and it worked as well as the rest of the macro.

JZ

 

[JLGWhiz]

Thank you JLG,

I got it to work after I went on the internet and found a code for inserting formulas with a macro. I re-did my code with what I found and it worked as well as the rest of the macro.

JZ

thanks for the feedback,
regards, JLG