Understanding This Code

Question

I have pasted below some code that works wonderfully for me. However, every time I try to use it on another set of columns, I cannot get it to work right, so can anyone possibly check my comments, and then complete comments for all the other lines, so that when I reuse it, I can figure out how to alter it?

Sub CustomChoices()

Dim ws1 As Worksheet, ws2 As Worksheet

Dim rA As Long, rB As Long, r As Long, N As Long, i As Integer

'This tells us the name of the SOURCE worksheet

Set ws1 = Sheets("CustomChoiceSets")

'This tells us the name of the DESTINATION worksheet

Set ws2 = Sheets("ChoicesData")

Application.ScreenUpdating = False

'This tells us the FIRST cell in column A of the SOURCE worksheet

rA = ws1.Cells(Rows.Count, "A").End(xlUp).Row

'This tells us the LAST cell in column B of the SOURCE worksheet

rB = ws1.Cells(Rows.Count, "B").End(xlUp).Row

'This Counts the number of rows in column A of the DESTINATION worksheet

r = ws2.Cells(Rows.Count, "A").End(xlUp).Row

'This checks to see if A1 in the DESTINATION worksheet is empty. If not, start pasting in first blank row

If ws2.Range("A1") = "" Then N = 1 Else: N = r + 1

'....

For i = 2 To rA

ws1.Cells(i, 1).Copy

ws2.Cells(N, 1).Resize(rB - 1).PasteSpecial xlValues

ws1.Range("B2:B" & rB).Copy

ws2.Cells(N, 2).PasteSpecial xlValues

N = ws2.Cells(Rows.Count, "A").End(xlUp).Row + 1

Next i

'Application.CutCopyMode = False

'Application.ScreenUpdating = True

End Sub

For instance, right now, I want to...on ONE worksheet called mapchoices, take the data from columns B and C and paste into H and I. But my currently altered code CUTS the data from column A (huh?) and pastes only . I took the code above and altered it to the code below. Of course, I've tried changing various values and can't get it to work, so if something I changed looks ridiculous, it's because I'm ridiculously desperate. LOL

Sub MapChoices()

Dim ws1 As Worksheet, ws2 As Worksheet

Dim rA As Long, rB As Long, r As Long, N As Long, i As Integer

Set ws1 = Sheets("MapChoices")

Set ws2 = Sheets("MapChoices")

'Application.ScreenUpdating = False

rA = ws1.Cells(Rows.Count, "C").End(xlUp).Row

rB = ws1.Cells(Rows.Count, "D").End(xlUp).Row

r = ws2.Cells(Rows.Count, "H").End(xlUp).Row

If ws2.Range("H2") = "" Then N = 1 Else: N = r + 1

For i = 2 To rA

ws1.Cells(i, 2).Copy

ws2.Cells(N, 1).Resize(rB - 1).PasteSpecial xlValues

ws1.Range("D2:D" & rB).Copy

ws2.Cells(N, 9).PasteSpecial xlValues

N = ws2.Cells(Rows.Count, "A").End(xlUp).Row + 1

Next i

Application.CutCopyMode = False

'Application.ScreenUpdating = True

End Sub

Answer 1

Sub CustomChoices()

Dim ws1 As Worksheet, ws2 As Worksheet

Dim rA As Long, rB As Long, r As Long, N As Long, i As Integer

'This tells us the name of the SOURCE worksheet  >>>YES

Set ws1 = Sheets("CustomChoiceSets")

'This tells us the name of the DESTINATION worksheet >>>YES

Set ws2 = Sheets("ChoicesData") 

Application.ScreenUpdating = False

'This tells us the FIRST cell in column A of the SOURCE worksheet >>>NO, finds 'the last not empty cell (in column A),' e.g if in column A there is only one value in cell A12 (A1 - A11 are empty) ' then returns 12 If column A is empty returns 1

rA = ws1.Cells(Rows.Count, "A").End(xlUp).Row

'This tells us the LAST cell in column B of the SOURCE worksheet >>>>YES like rA

rB = ws1.Cells(Rows.Count, "B").End(xlUp).Row

'This Counts the number of rows in column A of the DESTINATION worksheet >>> YES like' rA and rB but on ws2 and in column A

r = ws2.Cells(Rows.Count, "A").End(xlUp).Row

'This checks to see if A1 in the DESTINATION worksheet is empty. If not, start pasting in first blank row >>> YES

If ws2.Range("A1") = "" Then N = 1 Else: N = r + 1

'....

For i = 2 To rA

ws1.Cells(i, 1).Copy

ws2.Cells(N, 1).Resize(rB - 1).PasteSpecial xlValues

ws1.Range("B2:B" & rB).Copy

ws2.Cells(N, 2).PasteSpecial xlValues

N = ws2.Cells(Rows.Count, "A").End(xlUp).Row + 1

Next i

'Application.CutCopyMode = False

'Application.ScreenUpdating = True

End Sub

XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

.... 'take data'

you mean: 'cut data'

from  columns B and C??

if so, try this

(first, make a copy...)

Sub MapChoices()

Dim ws1 As Worksheet

Dim rB As Long, rC As Long

Set ws1 = Sheets("MapChoices")

'Application.ScreenUpdating = False

rB = ws1.Cells(Rows.Count, "B").End(xlUp).Row

rC = ws1.Cells(Rows.Count, "C").End(xlUp).Row

ws1.Range("B1:B" & rB).Copy Destination:=ws1.Range("H1")

ws1.Range("B1:B" & rB).ClearContents

ws1.Range("C1:C" & rC).Copy Destination:=ws1.Range("I1")

ws1.Range("C1:C" & rC).ClearContents

'Application.ScreenUpdating = True

End Sub

Answer 2

Hi

If you're finish with this post, would you be kind enough to mark it as answered.

Thank you

Cimjet

Answer 3

This is beautiful. I am on another small project right now, but will likely get to this in a day or two.

Thanks again, TasosK. You are my BFF.

Cimjet, thanks for your input. I will certainly check it out as well!

Answer 4

Hi Anne

Everyone has is style for writing script. I wrote this one in a way I think it would be simple to understand and easy for you to modify.

First try it to be sure it's what you want!! LOL

Option Explicit

Sub transfer_it()

Dim LastrowB As Long, LastrowC As Long, LastrowH As Long, LastrowI As Long

Dim I As Integer, x As Integer

Application.ScreenUpdating = False

LastrowB = Sheets("Sheet1").Cells(Cells.Rows.Count, "B").End(xlUp).Row

LastrowC = Sheets("Sheet1").Cells(Cells.Rows.Count, "C").End(xlUp).Row

For I = 2 To LastrowB

LastrowH = Sheets("Sheet1").Cells(Cells.Rows.Count, "H").End(xlUp).Row + 1

        Sheets("Sheet1").Cells(I, 2).Copy _

        Destination:=Sheets("Sheet1").Cells(LastrowH, "H")

        Next I

For x = 2 To LastrowC

LastrowI = Sheets("Sheet1").Cells(Cells.Rows.Count, "I").End(xlUp).Row + 1

        Sheets("Sheet1").Cells(x, 3).Copy _

        Destination:=Sheets("Sheet1").Cells(LastrowI, "I")

        Next x

Application.ScreenUpdating = True

End Sub

Hope this is helpful

Cimjet