Why is my macro running slowly?

limit-up

New Member
Joined
Dec 19, 2008
Messages
2
I made a basic macro to cut and paste data from one cell into another cell. I only wanted it to do it 26 times each time I run the macro. It used to run quickly but now is getting slower and slower. In the raw data there are small pictures and hyperlinks that occasionally get copy and pasted with the data.
Basically what I want it to do is this:
I have raw data that is in 26 sections. Each section has this format:
Name
ph number
st. address
city, state

and I want each section to be cut and pasted without hyperlinks, in a standard format, and in individual columns like this: Name, ph number, st. address, city state
It's working, but it's working slowly, and excel is starting to not respond when I run the macro.
I've tried turning calculations to manual and am not running any other applications.

Thanks,
Limit-up
 

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
75,362
Office Version
365
Platform
Windows
Any chance of seeing the code?:)

Some sample data wouldn't do any harm either.
 

Diablo II

Well-known Member
Joined
Sep 28, 2008
Messages
538
their is some thange i read , in a post on this site, i think in a post that if you delet the files out of the windows temp directory excel will run faster.
 

limit-up

New Member
Joined
Dec 19, 2008
Messages
2
of course...

John Smith
(604)555-0000
123 Old Yale Rd
Abbotsford , BC V2T4N1
My Address Book
Add to Facebook <table border="0" cellpadding="0" cellspacing="0" width="100%"> <tbody><tr> </tr> </tbody></table>

I wrote the code to omit the "My Address book" and "Add to Facebook" sections and the last couple of lines of code is to remove the hyperlink on the name. I think that the small facebook icon and the other icon to the left of the My Address Book are screwing things up but I'm not basing that on anything.
thanks,
Limit-up

range("C3").Select
Selection.Cut
range("G2").Select
ActiveSheet.Paste
range("C4").Select
Selection.Cut
range("H2").Select
ActiveSheet.Paste
range("C5").Select
Selection.Cut
range("I2").Select
ActiveSheet.Paste
range("C6").Select
Selection.Cut
range("J2").Select
ActiveSheet.Paste
range("C10").Select
Selection.Cut
range("G3").Select
ActiveSheet.Paste
range("C11").Select
Selection.Cut
range("H3").Select
ActiveSheet.Paste
range("C12").Select
Selection.Cut
range("I3").Select
ActiveSheet.Paste
range("C13").Select
Selection.Cut
range("J3").Select
ActiveSheet.Paste
range("C17").Select
Selection.Cut
range("G4").Select
ActiveSheet.Paste
range("C18").Select
Selection.Cut
range("H4").Select
ActiveSheet.Paste
range("C19").Select
Selection.Cut
range("I4").Select
ActiveSheet.Paste
range("C20").Select
Selection.Cut
range("J4").Select
ActiveSheet.Paste
range("C24").Select
Selection.Cut
range("G5").Select
ActiveSheet.Paste
range("C25").Select
Selection.Cut
range("H5").Select
ActiveSheet.Paste
range("C26").Select
Selection.Cut
range("I5").Select
ActiveSheet.Paste
range("C27").Select
Selection.Cut
range("J5").Select
ActiveSheet.Paste
range("C31").Select
Selection.Cut
range("G6").Select
ActiveSheet.Paste
range("C32").Select
Selection.Cut
range("H6").Select
ActiveSheet.Paste
range("C33").Select
Selection.Cut
range("I6").Select
ActiveSheet.Paste
range("C34").Select
Selection.Cut
range("J6").Select
ActiveSheet.Paste
range("C38").Select
Selection.Cut
range("G7").Select
ActiveSheet.Paste
range("C39").Select
Selection.Cut
range("H7").Select
ActiveSheet.Paste
range("C40").Select
Selection.Cut
range("I7").Select
ActiveSheet.Paste
range("C41").Select
Selection.Cut
range("J7").Select
ActiveSheet.Paste
range("C45").Select
Selection.Cut
range("G8").Select
ActiveSheet.Paste
range("C46").Select
Selection.Cut
range("H8").Select
ActiveSheet.Paste
range("C47").Select
Selection.Cut
range("I8").Select
ActiveSheet.Paste
range("C48").Select
Selection.Cut
range("J8").Select
ActiveSheet.Paste
range("C52").Select
Selection.Cut
range("G9").Select
ActiveSheet.Paste
range("C53").Select
Selection.Cut
range("H9").Select
ActiveSheet.Paste
range("C54").Select
Selection.Cut
range("I9").Select
ActiveSheet.Paste
range("C55").Select
Selection.Cut
range("J9").Select
ActiveSheet.Paste
range("C59").Select
Selection.Cut
range("G10").Select
ActiveSheet.Paste
range("C60").Select
Selection.Cut
range("H10").Select
ActiveSheet.Paste
range("C61").Select
Selection.Cut
ActiveSheet.Paste
range("i10").Select
range("D61").Select
range("C61").Select
Selection.Cut
range("I10").Select
ActiveSheet.Paste
range("C62").Select
Selection.Cut
range("J10").Select
ActiveSheet.Paste
range("C66").Select
Selection.Cut
range("G11").Select
ActiveSheet.Paste
range("C67").Select
Selection.Cut
range("H11").Select
ActiveSheet.Paste
range("C68").Select
Selection.Cut
range("I11").Select
ActiveSheet.Paste
range("C69").Select
Selection.Cut
range("J11").Select
ActiveSheet.Paste
range("C73").Select
Selection.Cut
range("G12").Select
ActiveSheet.Paste
range("C74").Select
Selection.Cut
range("H12").Select
ActiveSheet.Paste
range("C75").Select
Selection.Cut
range("I12").Select
ActiveSheet.Paste
range("C76").Select
Selection.Cut
range("J12").Select
ActiveSheet.Paste
range("C80").Select
range("C80").Select
Selection.Cut
range("G13").Select
ActiveSheet.Paste
range("C81").Select
Selection.Cut
range("H13").Select
ActiveSheet.Paste
range("C82").Select
Selection.Cut
range("I13").Select
ActiveSheet.Paste
range("C83").Select
Selection.Cut
range("J13").Select
ActiveSheet.Paste
range("C87").Select
Selection.Cut
range("G14").Select
ActiveSheet.Paste
range("C88").Select
Selection.Cut
range("H14").Select
ActiveSheet.Paste
range("C89").Select
Selection.Cut
range("I14").Select
ActiveSheet.Paste
range("C90").Select
Selection.Cut
range("J14").Select
ActiveSheet.Paste
range("C94").Select
Selection.Cut
range("G15").Select
ActiveSheet.Paste
range("C95").Select
Selection.Cut
range("H15").Select
ActiveSheet.Paste
range("C96").Select
Selection.Cut
range("I15").Select
range("C96").Select
Selection.Cut
range("I15").Select
ActiveSheet.Paste
range("C97").Select
Selection.Cut
range("J15").Select
ActiveSheet.Paste
range("C101").Select
Selection.Cut
range("G16").Select
ActiveSheet.Paste
range("C102").Select
Selection.Cut
range("H16").Select
ActiveSheet.Paste
range("C103").Select
Selection.Cut
range("I16").Select
ActiveSheet.Paste
range("C104").Select
Selection.Cut
range("J16").Select
ActiveSheet.Paste
range("C108").Select
Selection.Cut
range("G17").Select
ActiveSheet.Paste
range("C109").Select
Selection.Cut
range("H17").Select
ActiveSheet.Paste
range("C110").Select
Selection.Cut
range("I17").Select
ActiveSheet.Paste
range("C111").Select
Selection.Cut
range("J17").Select
ActiveSheet.Paste
range("C115").Select
Selection.Cut
range("G18").Select
ActiveSheet.Paste
range("C116").Select
Selection.Cut
range("H18").Select
ActiveSheet.Paste
range("C117").Select
Selection.Cut
range("I18").Select
ActiveSheet.Paste
range("C118").Select
Selection.Cut
range("J18").Select
ActiveSheet.Paste
range("C122").Select
Selection.Cut
range("G19").Select
ActiveSheet.Paste
range("C123").Select
Selection.Cut
range("H19").Select
ActiveSheet.Paste
range("C124").Select
Selection.Cut
range("I19").Select
ActiveSheet.Paste
range("C125").Select
Selection.Cut
range("J19").Select
ActiveSheet.Paste
range("C129").Select
Selection.Cut
range("G20").Select
ActiveSheet.Paste
range("C130").Select
Selection.Cut
range("H20").Select
ActiveSheet.Paste
range("C131").Select
Selection.Cut
range("I20").Select
ActiveSheet.Paste
range("C132").Select
Selection.Cut
range("J20").Select
ActiveSheet.Paste
range("C136").Select
Selection.Cut
range("G21").Select
ActiveSheet.Paste
range("C137").Select
Selection.Cut
range("H21").Select
ActiveSheet.Paste
range("C138").Select
Selection.Cut
range("I21").Select
ActiveSheet.Paste
range("C139").Select
Selection.Cut
range("J21").Select
ActiveSheet.Paste
range("C143").Select
Selection.Cut
range("G22").Select
ActiveSheet.Paste
range("C144").Select
Selection.Cut
range("H22").Select
ActiveSheet.Paste
range("C145").Select
Selection.Cut
range("I22").Select
ActiveSheet.Paste
range("C146").Select
Selection.Cut
range("J22").Select
ActiveSheet.Paste
range("C150").Select
Selection.Cut
range("G23").Select
ActiveSheet.Paste
range("C151").Select
Selection.Cut
range("h23").Select
ActiveSheet.Paste
range("C152").Select
Selection.Cut
range("I23").Select
ActiveSheet.Paste
range("H44").Select
range("C153").Select
Selection.Cut
range("J23").Select
ActiveSheet.Paste
range("C157").Select
Selection.Cut
range("G24").Select
ActiveSheet.Paste
range("C158").Select
Selection.Cut
range("H24").Select
ActiveSheet.Paste
range("C159").Select
Selection.Cut
range("I161").Select
ActiveSheet.Paste
range("I161").Select
Selection.Cut
range("I24").Select
ActiveSheet.Paste
range("C160").Select
Selection.Cut
range("J24").Select
ActiveSheet.Paste
range("C164").Select
Selection.Cut
range("G25").Select
ActiveSheet.Paste
range("C165").Select
Selection.Cut
range("H25").Select
ActiveSheet.Paste
range("C166").Select
Selection.Cut
range("I25").Select
ActiveSheet.Paste
range("C167").Select
Selection.Cut
range("J25").Select
ActiveSheet.Paste
range("C171").Select
Selection.Cut
range("G155").Select
range("G26").Select
ActiveSheet.Paste
range("G30").Select
range("C172").Select
Selection.Cut
range("H26").Select
ActiveSheet.Paste
range("C173").Select
Selection.Cut
range("I26").Select
ActiveSheet.Paste
range("C174").Select
Selection.Cut
range("J26").Select
ActiveSheet.Paste
range("C178").Select
Selection.Cut
range("G27").Select
ActiveSheet.Paste
range("C179").Select
Selection.Cut
range("H27").Select
ActiveSheet.Paste
range("C180").Select
Selection.Cut
range("I27").Select
ActiveSheet.Paste
range("C181").Select
Selection.Cut
range("J27").Select
ActiveSheet.Paste
range("g2:g26").Select
Selection.Copy
range("l2:l26").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
range("l2:l26").Select
Selection.Cut
range("g2:g26").Select
ActiveSheet.Paste

End Sub
 
Last edited:

Boller

Banned
Joined
Apr 11, 2006
Messages
2,328
Code:
Dim sRng As Range, dRng As Range, x&
Set sRng = [C3:C6]
Set dRng = [G2]
Application.ScreenUpdating = False
For x = 1 To 26
    sRng.Copy
    dRng.PasteSpecial Paste:=xlPasteAll, Transpose:=True
    sRng.ClearContents
    Set sRng = sRng.Offset(7)
    Set dRng = dRng.Offset(1)
Next
[G2:G6].Hyperlinks.Delete
Application.ScreenUpdating = True
 
Last edited:

jindon

MrExcel MVP
Joined
Aug 21, 2004
Messages
16,995
Do you have blank row(s) between the block of data ?
try this anyway
Code:
Sub test()
Dim myAreas As Areas, i As Long, x As Long
With ActiveSheet
    .Hyperlins.Delete
    With .Range("c3", .Range("c" & Rows.Count).End(xlUp))
        On Error ReSume Next
        Set myAreas = .SpecialCells(2).Areas
        On Error GoTo 0
        If myAreas Is Nothing Then Exit Sub
    End With
    For i = 1 To myAreas.Count
        If myAreas(i).Rows.Count > 2 Then
            x = myAreas.Rows.Count - 1
            .Cells(i, "g").Resize(, x).Value = _
            Application.Transpose(myAreas(i).Resize(x).Value)
        Else
            .Cells(i, "g").Value = myAreas(i).Cells(1).Value
        End If
    Next
End With
End Sub
 

Forum statistics

Threads
1,081,561
Messages
5,359,611
Members
400,540
Latest member
JimUSMC

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top