Huge favor/help required with complicated Macros

M

minette

Board Regular
Joined
Jul 8, 2005
Messages
237
Hi everyone, I have a huge favor to ask. I have a macro which is running extremely slow (for days) and then timing out. It is processing 40000 plus rows of data, taken from 7+ files. Part of the process is to look at several different cells in each row, and then doing something with them. It goes row, by row.... I don't want to post the code here, because it is over 1850 rows long (and also very ugly). I am a complete novice, hoping to learn as much as possible.

If anyone is able to have a look for me, then please let me know and I will PM the code and files for you to have a look.

This is causing me all sorts of problems, as I need it for work, and just cannot get it to run properly.

Your help would really be very much appreciated.
Minette
 
Sort by date Sort by votes
Hi ADAMC - I have emailed you the file - it's quite big, so I have zipped it up.

Norie - I have pasted some of the code - with the changes I made as suggested by ADAMC, although it is still not working.


Code: 
Dim ToBook As String            'Master Workbook (where all data needs to be copied to)
Dim FromBook As String          'Data files (where all the data needs to be copied from)
Dim ToSheet As Worksheet        'Master file ("RAW DATA" Sheet)
Dim FromSheet As Worksheet      'Data files ("DATA****" sheets)
Dim ToRow As Long               'Master file ("RAW DATA" Sheet), in the first empty row
Dim NumColumns As Integer       'ToSheet.Range("A1").End(xlToRight).Column
Dim NumRows As Integer          'Master file ("RAW DATA" Sheet) - Number of rows
Dim LastRowFromBook As Long     'Sheets("RAW DATA").Range("a65536").End(xlUp).Offset(1, 0).Row

Dim LastRowToBook As Long       'Sheets("RAW DATA").Range("a65536").End(xlUp).Offset(1, 0).Row
Dim LastRowValidation As Long   'Sheets("VALIDATION").Range("a65536").End(xlUp).Offset(1, 0).Row
Dim My_Message1 As String
Dim My_Message2 As String
Dim My_Message3 As String
Dim My_Message4 As String
Dim My_Message5 As String
Dim My_Message6 As String

Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long
Sub ChDirNet(szPath As String)
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(szPath)
If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path."
End Sub
Sub Files_From_Folder()

'opens the workbook where data will be copied from
Application.ScreenUpdating = False
Dim starttime As Date
Dim endtime As Date
starttime = Now()

Application.Calculation = xlCalculationManual
ChDirNet ActiveWorkbook.Path

ToBook = ActiveWorkbook.Name
FromBook = Dir("*.xls")
Set ToSheet = Sheets("RAW DATA")
ToRow = ToSheet.Range("A65536").End(xlUp).Row + 1
LastRowToBook = Worksheets("RAW DATA").Range("A" & Rows.Count).End(xlUp).Row

Workbooks(ToBook).Activate
While FromBook <> ""
    If FromBook <> ToBook Then
        Call Transfer_data
    End If
    FromBook = Dir
Wend
Call Copy_To_LastRowToBook
Workbooks(ToBook).Activate

Application.StatusBar = False
endtime = Now()
Application.ScreenUpdating = True
LotusNotesSendEmail
MsgBox "Done: This routine took " & Format(endtime - starttime, "hh:mm:ss") & " secs"
Application.Calculation = xlCalculationAutomatic
End Sub
Sub Copy_To_LastRowToBook()
    Worksheets("sheet1").Select
    Range("G17").Select
    ActiveCell.FormulaR1C1 = "=IF('RAW DATA'!R[-15]C[-1]="""",1,0)"
    Worksheets("sheet1").Select
    Range("S17").Select
    ActiveCell.FormulaR1C1 = "=LEN('RAW DATA'!R[-15]C[-13])"
Dim LastRowToBook As Long
LastRowToBook = Worksheets("RAW DATA").Range("A" & Rows.Count).End(xlUp).Row

With Worksheets("sheet1").Range("A17:AI17")
        Range("A17:AI" & LastRowToBook + 17).Copy
    End With
End Sub
Private Sub Transfer_data()
Dim FromData As String
Dim ToRow1 As String
'copy data from the data files to the validation file.
'if the validation file alrady has more than 40000 rows, create a new file, copy the RAW_DATA and VALIDATION tabsheets.
'Paste the data in the new file which should not have too many rows of data.
Application.DisplayAlerts = False
Workbooks.Open Filename:=FromBook, ReadOnly:=False
For Each FromSheet In Workbooks(FromBook).Worksheets
    If LCase(Left(FromSheet.Name, 4)) = "data" Then
        With FromSheet
        '####PROBLEM WITH MACRO
        'If there's more than one sheet with DATA* as the sheetname, the code does not do the tabsheets separately
        'but counts how many sheets with DATA* as the sheetname, and then does the "FIND_REPLACE" and "REPLACEMENT" procedures
        'as many times as there are DATA* sheets in the file but on the same sheet
             .Unprotect
             Call Find_Replace
             Call Replacement
             .Range("A2:AI" & .Range("A2").End(xlDown).Row).Copy
             ToSheet.Range("A" & ToRow).PasteSpecial
             ToRow = ToSheet.Range("A65536").End(xlUp).Row + 1
             If ToRow > 40000 Then
                Workbooks.Add
                ActiveWorkbook.SaveAs Filename:= _
                    "Y:\2007\PROPERTY\TESTMACRO\test 250607\Book222.xls", FileFormat _
                    :=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
                    False, CreateBackup:=False
                Workbooks(ToBook).Activate
                Sheets("RAW DATA").Select
                Sheets("RAW DATA").Copy Before:=Workbooks("Book222.xls").Sheets(1)
                Workbooks(ToBook).Activate
                Sheets("VALIDATION").Select
                Sheets("VALIDATION").Copy Before:=Workbooks("Book222.xls").Sheets(1)
                Workbooks(ToBook).Activate
                Windows("Book222.xls").Activate
                Sheets("RAW DATA").Select
                Rows("2:2").Select
                Range(Selection, Selection.End(xlDown)).Select
                Selection.ClearContents
                Range("A2").Select
                ActiveWorkbook.Save
                Workbooks(FromBook).Activate
                .Range("A2:AI" & .Range("A2").End(xlDown).Row).Copy
                ToRow = ToSheet.Range("A65536").End(xlUp).Row + 1
                Windows("Book222.xls").Activate
                ActiveSheet.Range("A" & ToRow).PasteSpecial
           End If
        End With
    End If

Next FromSheet
Workbooks(FromBook).Close savechanges:=True
End Sub
Sub Find_Replace()
    Columns("H:H").NumberFormat = "d-mmm-yy"
    Range("I:I,K:K,U:U").NumberFormat = "m/d/yyyy h:mm"
    Columns("M:M").NumberFormat = "0.00"
    Columns("N:N").NumberFormat = "0.00"
    Columns("Z:AI").NumberFormat = "0.00"
    Range("P:P,O:O,L:L,Q:Q,V:V,R:R").NumberFormat = "m/d/yyyy"

    Columns("D:D").Select
    Selection.Replace What:="Check This", Replacement:="Other", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Asda Dundee", Replacement:="Asda", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Bradford Schemes", Replacement:="Bradford (Non Abbey)", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Bradford Schemes Your Move. MBNA", Replacement:="Bradford (Non Abbey)", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Dundee - Other", Replacement:="Dundee Other", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Newcastle Claims", Replacement:="Newcastle", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Perth - Other", Replacement:="Perth Other", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Abbey (new)", Replacement:="Abbey", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Southend Commercial Claims", Replacement:="NU Commercial Southend", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Clubline Perth", Replacement:="Clubline - Perth", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Clubline Pune", Replacement:="Clubline - Pune", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Abbey (new)", Replacement:="Abbey", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Clubline - Bradford", Replacement:="Clubline", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Clubline - Dundee", Replacement:="Clubline", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Derbyshire B.S", Replacement:="Worthing Other", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Naaffi & Folgate - Worthing", Replacement:="Naaffi and Folgate", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Worthing Corporate Partners", Replacement:="Worthing Other", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Worthing Others", Replacement:="Worthing Other", LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:=" ", Replacement:="", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="Bradford (Non Abbey) Your Move. MBNA", Replacement:="Bradford (Non Abbey)", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="NU Exeter", Replacement:="Barclays", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="NU Glasgow", Replacement:="Other", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Columns("C:C").Select
    Selection.Replace What:="RAC", Replacement:="Claim Centre", LookAt:=xlWhole, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Columns("B:B").Select
    Selection.Replace What:="DALEB", Replacement:="DALEM", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Columns("F:F").Select
    Selection.Replace What:="***PLEASE DO NOT SCAN***", Replacement:="*DO NOT SCAN*", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    Columns("O:O").Select
    Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End Sub
Public Sub Replacement()

Application.ScreenUpdating = False
Dim starttime As Date
Dim endtime As Date
starttime = Now()

    Dim rng As Range
    Dim strName As Variant
    Dim UpdateCell As Range
    Dim n As Integer
    Dim startloc
    Dim LastRowFromBook As Long
    LastRowFromBook = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

    Set rng = Columns("W")
    '=======================
    Set startloc = Range("A2")
    '--------------------
    If LastRowFromBook < 10000 Then
        Call Looping1 'n = 2 To 10000
        Else
    If LastRowFromBook > 10001 And LastRowFromBook < 20000 Then
        Call Looping1 'n = 2 To 10000
        Call Looping2 'n = 10001 To 20000
        Else
    If LastRowFromBook > 20001 And LastRowFromBook < 30000 Then
        Call Looping1 'n = 2 To 10000
        Call Looping2 'n = 10001 To 20000
        Call Looping3 'n = 20001 To 30000
        Else
    If LastRowFromBook > 30001 And LastRowFromBook < 40000 Then
        Call Looping1 'n = 2 To 10000
        Call Looping2 'n = 10001 To 20000
        Call Looping3 'n = 20001 To 30000
        Call Looping4 'n = 30001 To 40000
        Else
    If LastRowFromBook > 40001 And LastRowFromBook < 50000 Then
        Call Looping1 'n = 2 To 10000
        Call Looping2 'n = 10001 To 20000
        Call Looping3 'n = 20001 To 30000
        Call Looping4 'n = 30001 To 40000
        Call Looping5 'n = 40001 To 50000
        Else
    If LastRowFromBook > 50001 And LastRowFromBook < 60000 Then
        Call Looping1 'n = 2 To 10000
        Call Looping2 'n = 10001 To 20000
        Call Looping3 'n = 20001 To 30000
        Call Looping4 'n = 30001 To 40000
        Call Looping5 'n = 40001 To 50000
        Call Looping6 'n = 50001 To 60000
        Else
    If LastRowFromBook > 60001 And LastRowFromBook < 65536 Then
        Call Looping1 'n = 2 To 10000
        Call Looping2 'n = 10001 To 20000
        Call Looping3 'n = 20001 To 30000
        Call Looping4 'n = 30001 To 40000
        Call Looping5 'n = 40001 To 50000
        Call Looping6 'n = 50001 To 60000
        Call Looping7 'n = 60001 To LastRowFromBook
    End If
    End If
    End If
    End If
    End If
    End If
    End If

endtime = Now()
Application.ScreenUpdating = True
MsgBox "Done: This routine took " & Format(endtime - starttime, "hh:mm:ss") & " secs"
End Sub
Sub Looping1()
Dim rng As Range
Dim strName As Variant
Dim UpdateCell As Range
Dim n As Integer
Dim startloc
LastRowFromBook = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

Set rng = Columns("W")
    Set startloc = Range("A2")
        For n = 2 To LastRowFromBook

        '1a.  If Instructing Unit (C) is "Anglia", then replace with "Other"
        
        If Range("C" & n) = "Anglia" Then Range("C" & n) = "Other" Else Range("C" & n) = Range("C" & n)

        '1a.  If Instructing Unit (C) is "Gab Robins", then replace with "Other"
        
        If Range("C" & n) = "Gab Robins" Then Range("C" & n) = "Other" Else Range("C" & n) = Range("C" & n)
                
        '1a.  If Instructing Unit (C) is "Roland Smith Ltd", then replace with "Other"
        
        If Range("C" & n) = "Roland Smith Ltd" Then Range("C" & n) = "Other" Else Range("C" & n) = Range("C" & n)

        '1a.  If Claim Centre (D) is "Roland Smith Ltd", then replace with "Other"
        
        If Range("D" & n) = "Roland Smith Ltd" Then Range("D" & n) = "Other" Else Range("C" & n) = Range("C" & n)


        '1.  If Claim Centre (D) is "Norwich Commercial Centre" or "NU Commercial Southend", then put commodity as "BoB Comm" (J)
        
        If Range("D" & n) = "Norwich Commercial Centre" Or Range("D" & n) = "NU Commercial Southend" Then Range("J" & n) = "BoB Comm" Else Range("D" & n) = Range("D" & n)

        '2.  If Claim Centre (D) is "Oval Peverel", put "Broker DA" in Commodity (J)
        
        If Range("D" & n) = "Oval Peverel" Then Range("J" & n) = "Broker DA" Else Range("D" & n) = Range("D" & n)

        '3.  If Claim Status (W) is blank, put "Work in Progress" in Claim Status (W)
        
        If Range("W" & n) = "" And Range("A" & n) <> "Complete" Then Range("W" & n) = "Work in Progress" Else Range("W" & n) = Range("W" & n)
        If Range("W" & n) = "" And Range("A" & n) = "Complete" Then Range("W" & n) = "Closed" Else Range("W" & n) = Range("W" & n)
        
        '4.  If Invoice Date (O) is blank and Claim Type is "Completed", put last day of the month in Invoice date (from file date)(O)
        
        If Range("O" & n) = "" And Range("A" & n) = "Complete" Then Range("O" & n).FormulaR1C1 = "=EOMONTH(NOW(),0)" Else Range("O" & n) = Range("O" & n)
        
        '5a.  If Claim Reference (F) starts with "PV" or "OM", put "Oval Peverel" in Claim Centre (D)
        
        If Left(Range("F" & n), 2) = "OM" Or Left(Range("G" & n), 2) = "PV" Then Range("D" & n) = "Oval Peverel" Else Range("D" & n) = Range("D" & n)
        If Left(Range("F" & n), 2) = "OM" Or Left(Range("G" & n), 2) = "PV" Then Range("J" & n) = "Broker DA" Else Range("D" & n) = Range("D" & n)
        
        '5b.  If Policy Number (G) starts with "PV" or "OM", put "Oval Peverel" in Claim Centre (D)
        
        If Left(Range("G" & n), 2) = "OM" Or Left(Range("G" & n), 2) = "PV" Then Range("D" & n) = "Oval Peverel" Else Range("D" & n) = Range("D" & n)
        If Left(Range("G" & n), 2) = "OM" Or Left(Range("G" & n), 2) = "PV" Then Range("J" & n) = "Broker DA" Else Range("D" & n) = Range("D" & n)
        
        '6a.  If Claim Reference (F) is blank, but Policy Number (G) is not, copy G into F. If both blank, put "Not Known"
        
        If Range("F" & n) = "" And Range("G" & n) <> "" Then Range("F" & n) = Range("G" & n) Else Range("F" & n) = Range("F" & n)

        '6b.  If Claim Reference (F) and Policy Number (G) is blank, put "Not Known" (see above)
        
        If Range("F" & n) = "" And Range("G" & n) = "" Then Range("F" & n) = "Not Known" Else Range("F" & n) = Range("F" & n)
        
        If Range("F" & n) = "Not known" And Range("G" & n) = "" Then Range("G" & n) = "Not Known" Else Range("G" & n) = Range("G" & n)
       
        '7a.  If Claim Reference (F) length is greater than 40 - trim from left
        Range("F" & n).Select
        ActiveCell.FormulaR1C1 = "=IF(LEN(RC[-33])>40,LEFT(RC[-33],40),RC[-33])"
        '7b.  If Range("AM" & n) > 40 Then
        ActiveCell.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        Selection.Cut
        
        ActiveSheet.Paste
       
        '12.  If Type (A) is not "Complete", delete Outcome (X)
        If Range("A" & n) <> "Complete" Then Range("X" & n) = "" Else Range("X" & n) = Range("X" & n)

        '16a. If Postcode (S) has a space at the end, trim from right
        
        If Right(Range("S" & n), 1) = " " Then Range("R" & n) = Left(Range("S" & n), 8) Else Range("S" & n) = Range("S" & n)
        
        '16b. If Postcode (S) has 3 digits followed by a small "n" and four digits, remove the small "n" in the middle
        
        If Mid(Range("S" & n), 4, 1) = "n" Then Selection.Replace What:="n", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
        
        '16c. If Postcode (S) has more than 9 digits, trim from right
        If Len(Range("S" & n)) > 8 Then
            My_Message1 = My_Message1 & Chr(13) & Range("S" & n) & " - Cell Ref: "
        End If
        
        '16d. If Postcode (S) has is empty - put "NOT KNWN"
        
        If Range("S" & n) <> "" Then Range("S" & n) = "NOT KNWN" Else Range("S" & n) = Range("S" & n)
        
        '17a.  If Supplier Reference (B) starts with CARIL and is longer than 12 characters, trim from right
        If Left(Range("B" & n), 5) = "CARIL" Then
            Range("AM" & n).FormulaR1C1 = "=IF(LEN(RC[-37])>12,IF(LEFT(RC[-37],5)=""CARIL"",LEFT(RC[-37],12),RC[-37]),RC[-37])"
        Range("AM" & n).Select
        ActiveCell.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        Selection.Cut
        Range("B" & n).Select
        ActiveSheet.Paste
        
        '17b.  If Supplier Reference (B) starts with IMPRO and is longer than 11 characters, trim from right

        ElseIf Left(Range("B" & n), 5) = "IMPRO" Then
            Range("AM" & n).FormulaR1C1 = "=IF(LEN(RC[-37])>11,IF(LEFT(RC[-37],5)=""IMPRO"",LEFT(RC[-37],11),RC[-37]),RC[-37])"

        Range("AM" & n).Select
        ActiveCell.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        Selection.Cut
        Range("B" & n).Select
        ActiveSheet.Paste
        Else
            Range("B" & n) = Range("B" & n)
        End If
    Next n
End Sub
 
Upvote 0

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
When you say 'its still not working'...

What error message does it give, which line of code is highlighted?
 
Upvote 0
minette

As has been suggested there is unneeded selecting going on.

This:
Code: 
Worksheets("sheet1").Select 
    Range("G17").Select 
    ActiveCell.FormulaR1C1 = "=IF('RAW DATA'!R[-15]C[-1]="""",1,0)" 
    Worksheets("sheet1").Select 
    Range("S17").Select 
    ActiveCell.FormulaR1C1 = "=LEN('RAW DATA'!R[-15]C[-13])"
Can be replaced with this:
Code: 
With Worksheets("sheet1")
   .Range("G17").FormulaR1C1 = "=IF('RAW DATA'!R[-15]C[-1]="""",1,0)" 
   .Range("S17").FormulaR1C1 = "=LEN('RAW DATA'!R[-15]C[-13])" 
End With
Also

What's the point of the Else part here?
Code: 
If Range("C" & n) = "Anglia" Then Range("C" & n) = "Other" Else Range("C" & n) = Range("C" & n)
You might also want to look into using Select Case and arrays.
 
Upvote 0
Norie - The "Else" is there if the criteria is not met, I want the cell to stay the same.

ADAMC - I get the "selection is too large on the following line:-
Code: 
Range("A17:AI26000").Copy
 
Upvote 0
What version of Excel are you using?
What happened when you put:

Sub copyme ()
Range("A17:AI26000").Copy
End Sub

in a sub of its own....?
 
Upvote 0
minette

If that's what you want the Else for it's not needed as far as I can see.
 
Upvote 0
Thanks Norie, I'll take it out.
ADAMC, I am using Excel 2002. I have placed the code in it's own sub, but still got the "selection is too large error. In the end, I've narrowed it down to 4112 rows that I am able to copy at a time. Go to 4113, and I get the "selection is too large" error.
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question
VBA to split worksheets going through motions and confirming saved in directory... but nothing there when I check!
Replies
2
Views
151
Joe4
Joe4
J
  • Question
VBA to split table and retain formatting
Replies
1
Views
211
XLfriend777
XLfriend777
C
  • Question
Calculations require application restart
Replies
2
Views
150
cpupartsplz
C
L
  • Question
How to group small variations on data
2 3
Replies
22
Views
261
awoohaw
awoohaw
S
  • Question
Can a macro help create a user hierarchy?
Replies
7
Views
171
Akuini
Akuini

Forum statistics

Threads
1,214,979
Messages
6,122,552
Members
449,088
Latest member
davidcom

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top