Copying a variable based range of cells to another

Question

Hello from my code it should be evident what I am trying to do at this point. I am attempting to copy a range of cells from a static portion of a worksheet to a created column but I keep running into an error on a certain part of the formula I'm hoping that someone here has either a solution to the error, or a better method of taking one range of cells that can be static and bringing to a hard a reference point

Sub Mapping()

Dim Map As Worksheet
Dim Ath As Worksheet
Dim lastmap As Long
Dim lastath As Long
Set Ath = Sheets("Athena Greek God")
Set Map = Sheets("Mapping")
lastmap = Map.Cells(Rows.Count, "D").End(xlUp).Row
lastath = Ath.Cells(Rows.Count, "A").End(xlUp).Row



Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Range("A1") = "EDITED"
Range("B1") = "EDITED 2"
Range("C1") = "EDITED 3"
Range("D1") = "EDITED 4"
Columns("A:D").AutoFit
Range("A1:D" & lastath).Select
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.149998474074526
    .PatternTintAndShade = 0
End With

Clastath = Ath.Cells(1, Columns.Count).End(xlToLeft).Column

For x = Clastath To 1 Step -1
If ath.Cells(1, x) = "The Principals Book" Then
    ath.Range("D2: D" & lastath) = ath.Range(ath.Cells(2, x), ath.Cells(lastath, x))
End If
Next
End Sub

Error occurs here:

ath.Range("D2: D" & lastath) = ath.Range(ath.Cells(2, x), ath.Cells(lastath, x))

Answer 1

You should use .Value or .Value2 to transfer data between to ranges like this :

Ath.Range("D2: D" & LastAth).Value2 = Ath.Range(Ath.Cells(2, x), Ath.Cells(LastAth, x)).Value2

The main difference between these two is :

1. .Value2 gives you the underlying value of the cell (unformatted data)
2. .Value gives you the formatted value of the cell

For more details, take a look at Charles William's blog here.

---

As you seem to be working on two sheets (not on the "mapping" one in the code you gave, if I got that right. If not just change Ath. to Map. where it need to be), don't forget to use the references you created (I added them everywhere, even before Rows.Count and Columns.Count to avoid errors if you open an old document on a new Excel version)

I got rid of the Selects and shorten code where I could, but I let the "Mapping" sheet as I guessed you'll use it later in your code.

Also don't forget to free your abject variables like this, when you won't use it afterwards :

Set Ath = Nothing
Set Map = Nothing

---

---

Here is your code corrected, cleaned and tested :

Sub Mapping()

Dim Map As Worksheet, _
    Ath As Worksheet, _
    LastAth As Long, _
    LastMap As Long, _
    CLastAth As Long, _
    x As Integer


Set Ath = Sheets("Athena Greek God")
Set Map = Sheets("Mapping")
LastMap = Map.Cells(Map.Rows.Count, "D").End(xlUp).Row
LastAth = Ath.Cells(Ath.Rows.Count, "A").End(xlUp).Row

Ath.Columns("A:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Ath.Range("A1:D1").Value = Array("EDITED", "EDITED 2", "EDITED 3", "EDITED 4")
Ath.Columns("A:D").AutoFit

With Ath.Range("A1:D" & LastAth).Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.149998474074526
    .PatternTintAndShade = 0
End With


CLastAth = Ath.Cells(1, Ath.Columns.Count).End(xlToLeft).Column

For x = CLastAth To 1 Step -1
    If Ath.Cells(1, x) <> "The Principals Book" Then
    Else
        Ath.Range("D2: D" & LastAth).Value = Ath.Range(Ath.Cells(2, x), Ath.Cells(LastAth, x)).Value
    End If
Next x

Set Ath = Nothing
Set Map = Nothing

End Sub

Answer 2

Your code deserves several comments. To begin with, you have to solve your problem (see point 1). In addition, several points can reduce the chances of error upon modification, and improve efficiency.

1. Use other methods for copying Ranges.
   You have to specify what you want to copy (data, formulas, number formats, etc.) to decide which method to use.

   • Copy only data.

     Ath.Range("D2:D" & lastath).Value2 = Ath.Range(Ath.Cells(2, x), Ath.Cells(lastath, x)).Value2
     

     or

     Ath.Range(Ath.Cells(2, x), Ath.Cells(lastath, x)).Copy
     Ath.Range("D2:D" & lastath).PasteSpecial xlPasteValues
     

   • Copy (part or all of) number formats. See this.

     Ath.Range("D2:D" & lastath).Value = Ath.Range(Ath.Cells(2, x), Ath.Cells(lastath, x)).Value
     

     or

     Ath.Range(Ath.Cells(2, x), Ath.Cells(lastath, x)).Copy
     Ath.Range("D2:D" & lastath).PasteSpecial xlPasteValuesAndNumberFormats
     

   • Copy formulas.

     Ath.Range(Ath.Cells(2, x), Ath.Cells(lastath, x)).Copy
     Ath.Range("D2:D" & lastath).PasteSpecial xlPasteFormulas  ' or xlPasteFormulasAndNumberFormats
     

   • Copy all.

     Ath.Range(Ath.Cells(2, x), Ath.Cells(lastath, x)).Copy
     Ath.Range("D2:D" & lastath).PasteSpecial xlPasteAll
     

     or

     Ath.Range(Ath.Cells(2, x), Ath.Cells(lastath, x)).Copy Destination:=Ath.Range("D2:D" & lastath)
     

2. Fully qualify your Ranges.
   This issue shows up once and again (e.g., this).
   What does this mean? Do not use Cells, Range, Rows or Columns without specifying which Worksheet they belong to, unless you specifically want to do that (and even in that case, explicitly using ActiveSheet improves readability and reduces the chances of errors, similar to using Option Explicit). For instance,

   lastath = Ath.Cells(Rows.Count, "A").End(xlUp).Row
   

   will take Rows.Count from the ActiveSheet, which might not be Ath. You likely do not want that. The correct form is

   lastath = Ath.Cells(Ath.Rows.Count, "A").End(xlUp).Row
   

   Fix all other code. Note: in this case, code continues execution and the mistake may go unnoticed, as it produces a valid result. In other cases, code without fully qualified Ranges will throw an error (e.g., with something like sheet1.Range(Cells(..., when sheet1 is not the ActiveSheet).

3. Your code seems inefficient.
   You might be copying data many times into the same Range. It is better to find the leftmost cell in row 1, containing "The Principals Book", and copy the range for that column into Range("D2:D" & lastath). Use

   Dim x As Long
   For x = 1 To Clastath
       If Ath.Cells(1, x) = "The Principals Book" Then
           Ath.Range("D2:D" & lastath).Value2 = Ath.Range(Ath.Cells(2, x), Ath.Cells(lastath, x)).Value2   ' or alternatives above
           Exit For
       End If
   Next
   

4. It is not clear in which Worksheet you want columns inserted.
   It seems to be Ath. The other Worksheet is not used.

5. You can insert many columns at once. You can also enter data into a range at once.

   Ath.Columns("A:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
   Ath.Range("A1:D1").Value = Array("EDITED", "EDITED 2", "EDITED 3", "EDITED 4")
   

Answer 3

Actually, it is not really evident what this code should achieve, tell you why: Two worksheets are defined but only one of them is used, also It's not clear to which worksheet the code is to be applied. As it stand now, the code is applied to whatever worksheet is active.

See the code below with adjustments and comments. The code assumes the procedure should be apply to the Ath worksheet (change as needed)

Although the changes are explained, do let me know of any questions you might have about.

Option Explicit
Option Base 1

Sub Mapping()
Rem Worksheet "Map" is only used to obtain lastmap which is never used
Rem Therefore theese line are commented as they do not play any role in the procedure
'Dim Map As Worksheet
'Dim lastmap As Long
'Set Map = Sheets("Mapping")
'lastmap = Map.Cells(Rows.Count, "D").End(xlUp).Row ' NOT USED?

Rem Set array with titles - easy to maintain, and use to command all further intructions avoiding hard codding
Dim aTitles As Variant
aTitles = [{"EDITED","EDITED 2","EDITED 3","EDITED 4"}]

Dim Ath As Worksheet
Dim lastath As Long
Dim Clastath As Integer
Dim X As Integer

    Set Ath = Sheets("Athena Greek God")

    Rem It's not clear to which worksheet the code is to be applied?
    Rem Actually it is applied to whatever worksheet is active
    Rem This code assumes the procedure should be apply to the Ath worksheet
    With Ath '(change as needed)
        lastath = .Cells(Rows.Count, 1).End(xlUp).Row
        .Cells(1).Resize(, UBound(aTitles)).EntireColumn.Insert     'Using Titles array to insert required number of columns
        With Range(.Cells(1, 1), .Cells(lastath, UBound(aTitles)))  'Working with the range to be updated
            .Rows(1).Value = aTitles
            .Columns.AutoFit
            .Interior.Color = RGB(217, 217, 217)                    'Simplify method to set color

            Clastath = .Cells(1, Columns.Count).End(xlToLeft).Column

            Rem Use "Step -1" if you have more than one cell with value = "The Principals Book"
            Rem and you whant to catch the last occurrence. Otherwise no need to use it.
            Rem For X = Clastath To 1 Step -1 '(change if needed as per comment above)
            For X = 1 To Clastath
                If .Cells(1, X).Value = "The Principals Book" Then
                    Rem Old line, left only to show changes (.Value and .Value2)
                    Rem Ath.Range("D2: D" & lastath).Value = Ath.Range(Ath.Cells(2, X), Ath.Cells(lastath, X)).Value2
                    Ath.Range("D2: D" & lastath).Value = Ath.Range(Ath.Cells(2, X), Ath.Cells(lastath, X)).Value2
                    .Columns(4).Value = .Columns(1).Offset(0, X - 1).Value2
                    Exit For    'Exit For...Next after achieving its goal

    End If: Next: End With: End With

    Ath.Activate 'Only used to show\move to the worksheet updated

End Sub

Answer 4

1.Remove the space in your string address: Before:

ath.Range("D2: D" & lastath))

After:

ath.Range("D2:D" & lastath))

2a. If you only want to copy the values, then use .value at the end of your range references: Before:

ath.Range("D2:D" & lastath).value = ath.Range(ath.Cells(2, x), ath.Cells(lastath, x)) 

After:

ath.Range("D2:D" & lastath).value = ath.Range(ath.Cells(2, x).value, ath.Cells(lastath, x).value).value

2b. If you want values and formats then use .copy (destination): Before:

ath.Range("D2:D" & lastath).value = ath.Range(ath.Cells(2, x), ath.Cells(lastath, x)) 

After:

ath.Range("D2:D" & lastath).copy(ath.Range(ath.Cells(2, x).value, ath.Cells(lastath, x).value))

Also, you should always reference the worksheet of a references range (e.g. ws.range("A1").value). You might also consider using a worksheet's .codename rather then .name if this isn't just a quick an dirty project.

Answer 5

Take out the space after the :

I have also chopped your code down, Dimmed X and removed the selects for you:

Sub Mapping()

Dim Map As Worksheet, Ath As Worksheet, lastmap As Long, lastath As Long, X As Long, Clastath As Long
Set Ath = Sheets("Athena Greek God")
Set Map = Sheets("Mapping")
lastmap = Map.Cells(Rows.Count, "D").End(xlUp).Row
lastath = Ath.Cells(Rows.Count, "A").End(xlUp).Row

Columns("A:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1:D1") = Array("EDITED", "EDITED 2", "EDITED 3", "EDITED 4")
Columns("A:D").AutoFit
With Range("A1:D" & lastath).Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorDark1
    .TintAndShade = -0.149998474074526
    .PatternTintAndShade = 0
End With

Clastath = Ath.Cells(1, Columns.Count).End(xlToLeft).Column

For X = Clastath To 1 Step -1
    If Cells(1, X) = "The Principals Book" Then
        Range("D2:D" & lastath) = Range(Cells(2, X), Cells(lastath, X))
    End If
Next
End Sub

Edit: Also dimmed Clastath as long